cgcpu.pas 80 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108
  1. {
  2. Copyright (c) 2003 by Florian Klaempfl
  3. Member of the Free Pascal development team
  4. This unit implements the code generator for the ARM
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit cgcpu;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. globtype,symtype,symdef,
  23. cgbase,cgutils,cgobj,
  24. aasmbase,aasmcpu,aasmtai,aasmdata,
  25. parabase,
  26. cpubase,cpuinfo,node,cg64f32,rgcpu;
  27. type
  28. tcgarm = class(tcg)
  29. { true, if the next arithmetic operation should modify the flags }
  30. cgsetflags : boolean;
  31. procedure init_register_allocators;override;
  32. procedure done_register_allocators;override;
  33. procedure a_param_const(list : TAsmList;size : tcgsize;a : aint;const paraloc : TCGPara);override;
  34. procedure a_param_ref(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);override;
  35. procedure a_paramaddr_ref(list : TAsmList;const r : treference;const paraloc : TCGPara);override;
  36. procedure a_call_name(list : TAsmList;const s : string);override;
  37. procedure a_call_reg(list : TAsmList;reg: tregister);override;
  38. procedure a_call_ref(list : TAsmList;ref: treference);override;
  39. procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: aint; reg: TRegister); override;
  40. procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
  41. procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg;
  42. size: tcgsize; a: aint; src, dst: tregister); override;
  43. procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg;
  44. size: tcgsize; src1, src2, dst: tregister); override;
  45. procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister;setflags : boolean;var ovloc : tlocation);override;
  46. procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation);override;
  47. { move instructions }
  48. procedure a_load_const_reg(list : TAsmList; size: tcgsize; a : aint;reg : tregister);override;
  49. procedure a_load_reg_ref(list : TAsmList; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);override;
  50. procedure a_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);override;
  51. procedure a_load_reg_reg(list : TAsmList; fromsize, tosize : tcgsize;reg1,reg2 : tregister);override;
  52. function a_internal_load_reg_ref(list : TAsmList; fromsize, tosize: tcgsize; reg : tregister;const ref : treference):treference;
  53. function a_internal_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister):treference;
  54. { fpu move instructions }
  55. procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override;
  56. procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override;
  57. procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); override;
  58. procedure a_paramfpu_ref(list : TAsmList;size : tcgsize;const ref : treference;const paraloc : TCGPara);override;
  59. { comparison operations }
  60. procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : aint;reg : tregister;
  61. l : tasmlabel);override;
  62. procedure a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
  63. procedure a_jmp_name(list : TAsmList;const s : string); override;
  64. procedure a_jmp_always(list : TAsmList;l: tasmlabel); override;
  65. procedure a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); override;
  66. procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister); override;
  67. procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override;
  68. procedure g_proc_exit(list : TAsmList;parasize : longint;nostackframe:boolean); override;
  69. procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override;
  70. procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : aint);override;
  71. procedure g_concatcopy_unaligned(list : TAsmList;const source,dest : treference;len : aint);override;
  72. procedure g_concatcopy_move(list : TAsmList;const source,dest : treference;len : aint);
  73. procedure g_concatcopy_internal(list : TAsmList;const source,dest : treference;len : aint;aligned : boolean);
  74. procedure g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef); override;
  75. procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation);override;
  76. procedure g_save_standard_registers(list : TAsmList);override;
  77. procedure g_restore_standard_registers(list : TAsmList);override;
  78. procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
  79. procedure fixref(list : TAsmList;var ref : treference);
  80. function handle_load_store(list:TAsmList;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference):treference;
  81. procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
  82. end;
  83. tcg64farm = class(tcg64f32)
  84. procedure a_op64_reg_reg(list : TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64);override;
  85. procedure a_op64_const_reg(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;reg : tregister64);override;
  86. procedure a_op64_const_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64);override;
  87. procedure a_op64_reg_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);override;
  88. procedure a_op64_const_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override;
  89. procedure a_op64_reg_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override;
  90. end;
  91. const
  92. OpCmp2AsmCond : Array[topcmp] of TAsmCond = (C_NONE,C_EQ,C_GT,
  93. C_LT,C_GE,C_LE,C_NE,C_LS,C_CC,C_CS,C_HI);
  94. winstackpagesize = 4096;
  95. function get_fpu_postfix(def : tdef) : toppostfix;
  96. implementation
  97. uses
  98. globals,verbose,systems,cutils,
  99. fmodule,
  100. symconst,symsym,
  101. tgobj,
  102. procinfo,cpupi,
  103. paramgr;
  104. function get_fpu_postfix(def : tdef) : toppostfix;
  105. begin
  106. if def.typ=floatdef then
  107. begin
  108. case tfloatdef(def).floattype of
  109. s32real:
  110. result:=PF_S;
  111. s64real:
  112. result:=PF_D;
  113. s80real:
  114. result:=PF_E;
  115. else
  116. internalerror(200401272);
  117. end;
  118. end
  119. else
  120. internalerror(200401271);
  121. end;
  122. procedure tcgarm.init_register_allocators;
  123. begin
  124. inherited init_register_allocators;
  125. { currently, we save R14 always, so we can use it }
  126. rg[R_INTREGISTER]:=trgintcpu.create(R_INTREGISTER,R_SUBWHOLE,
  127. [RS_R0,RS_R1,RS_R2,RS_R3,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,
  128. RS_R9,RS_R10,RS_R12,RS_R14],first_int_imreg,[]);
  129. rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
  130. [RS_F0,RS_F1,RS_F2,RS_F3,RS_F4,RS_F5,RS_F6,RS_F7],first_fpu_imreg,[]);
  131. rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE,
  132. [RS_S0,RS_S1,RS_R2,RS_R3,RS_R4,RS_S31],first_mm_imreg,[]);
  133. end;
  134. procedure tcgarm.done_register_allocators;
  135. begin
  136. rg[R_INTREGISTER].free;
  137. rg[R_FPUREGISTER].free;
  138. rg[R_MMREGISTER].free;
  139. inherited done_register_allocators;
  140. end;
  141. procedure tcgarm.a_param_const(list : TAsmList;size : tcgsize;a : aint;const paraloc : TCGPara);
  142. var
  143. ref: treference;
  144. begin
  145. paraloc.check_simple_location;
  146. case paraloc.location^.loc of
  147. LOC_REGISTER,LOC_CREGISTER:
  148. a_load_const_reg(list,size,a,paraloc.location^.register);
  149. LOC_REFERENCE:
  150. begin
  151. reference_reset(ref);
  152. ref.base:=paraloc.location^.reference.index;
  153. ref.offset:=paraloc.location^.reference.offset;
  154. a_load_const_ref(list,size,a,ref);
  155. end;
  156. else
  157. internalerror(2002081101);
  158. end;
  159. end;
  160. procedure tcgarm.a_param_ref(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);
  161. var
  162. tmpref, ref: treference;
  163. location: pcgparalocation;
  164. sizeleft: aint;
  165. begin
  166. location := paraloc.location;
  167. tmpref := r;
  168. sizeleft := paraloc.intsize;
  169. while assigned(location) do
  170. begin
  171. case location^.loc of
  172. LOC_REGISTER,LOC_CREGISTER:
  173. a_load_ref_reg(list,location^.size,location^.size,tmpref,location^.register);
  174. LOC_REFERENCE:
  175. begin
  176. reference_reset_base(ref,location^.reference.index,location^.reference.offset);
  177. { doubles in softemu mode have a strange order of registers and references }
  178. if location^.size=OS_32 then
  179. g_concatcopy(list,tmpref,ref,4)
  180. else
  181. begin
  182. g_concatcopy(list,tmpref,ref,sizeleft);
  183. if assigned(location^.next) then
  184. internalerror(2005010710);
  185. end;
  186. end;
  187. LOC_FPUREGISTER,LOC_CFPUREGISTER:
  188. case location^.size of
  189. OS_F32, OS_F64:
  190. a_loadfpu_ref_reg(list,location^.size,location^.size,tmpref,location^.register);
  191. else
  192. internalerror(2002072801);
  193. end;
  194. LOC_VOID:
  195. begin
  196. // nothing to do
  197. end;
  198. else
  199. internalerror(2002081103);
  200. end;
  201. inc(tmpref.offset,tcgsize2size[location^.size]);
  202. dec(sizeleft,tcgsize2size[location^.size]);
  203. location := location^.next;
  204. end;
  205. end;
  206. procedure tcgarm.a_paramaddr_ref(list : TAsmList;const r : treference;const paraloc : TCGPara);
  207. var
  208. ref: treference;
  209. tmpreg: tregister;
  210. begin
  211. paraloc.check_simple_location;
  212. case paraloc.location^.loc of
  213. LOC_REGISTER,LOC_CREGISTER:
  214. a_loadaddr_ref_reg(list,r,paraloc.location^.register);
  215. LOC_REFERENCE:
  216. begin
  217. reference_reset(ref);
  218. ref.base := paraloc.location^.reference.index;
  219. ref.offset := paraloc.location^.reference.offset;
  220. tmpreg := getintregister(list,OS_ADDR);
  221. a_loadaddr_ref_reg(list,r,tmpreg);
  222. a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref);
  223. end;
  224. else
  225. internalerror(2002080701);
  226. end;
  227. end;
  228. procedure tcgarm.a_call_name(list : TAsmList;const s : string);
  229. begin
  230. list.concat(taicpu.op_sym(A_BL,current_asmdata.RefAsmSymbol(s)));
  231. {
  232. the compiler does not properly set this flag anymore in pass 1, and
  233. for now we only need it after pass 2 (I hope) (JM)
  234. if not(pi_do_call in current_procinfo.flags) then
  235. internalerror(2003060703);
  236. }
  237. include(current_procinfo.flags,pi_do_call);
  238. end;
  239. procedure tcgarm.a_call_reg(list : TAsmList;reg: tregister);
  240. begin
  241. list.concat(taicpu.op_reg_reg(A_MOV,NR_R14,NR_PC));
  242. list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,reg));
  243. {
  244. the compiler does not properly set this flag anymore in pass 1, and
  245. for now we only need it after pass 2 (I hope) (JM)
  246. if not(pi_do_call in current_procinfo.flags) then
  247. internalerror(2003060703);
  248. }
  249. include(current_procinfo.flags,pi_do_call);
  250. end;
  251. procedure tcgarm.a_call_ref(list : TAsmList;ref: treference);
  252. begin
  253. a_reg_alloc(list,NR_R12);
  254. a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,NR_R12);
  255. list.concat(taicpu.op_reg_reg(A_MOV,NR_R14,NR_PC));
  256. list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R12));
  257. a_reg_dealloc(list,NR_R12);
  258. include(current_procinfo.flags,pi_do_call);
  259. end;
  260. procedure tcgarm.a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: aint; reg: TRegister);
  261. begin
  262. a_op_const_reg_reg(list,op,size,a,reg,reg);
  263. end;
  264. procedure tcgarm.a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister);
  265. begin
  266. case op of
  267. OP_NEG:
  268. list.concat(taicpu.op_reg_reg_const(A_RSB,dst,src,0));
  269. OP_NOT:
  270. begin
  271. list.concat(taicpu.op_reg_reg(A_MVN,dst,src));
  272. case size of
  273. OS_8 :
  274. a_op_const_reg_reg(list,OP_AND,OS_INT,$ff,dst,dst);
  275. OS_16 :
  276. a_op_const_reg_reg(list,OP_AND,OS_INT,$ffff,dst,dst);
  277. end;
  278. end
  279. else
  280. a_op_reg_reg_reg(list,op,OS_32,src,dst,dst);
  281. end;
  282. end;
  283. const
  284. op_reg_reg_opcg2asmop: array[TOpCG] of tasmop =
  285. (A_NONE,A_MOV,A_ADD,A_AND,A_NONE,A_NONE,A_MUL,A_MUL,A_NONE,A_NONE,A_ORR,
  286. A_NONE,A_NONE,A_NONE,A_SUB,A_EOR);
  287. procedure tcgarm.a_op_const_reg_reg(list: TAsmList; op: TOpCg;
  288. size: tcgsize; a: aint; src, dst: tregister);
  289. var
  290. ovloc : tlocation;
  291. begin
  292. a_op_const_reg_reg_checkoverflow(list,op,size,a,src,dst,false,ovloc);
  293. end;
  294. procedure tcgarm.a_op_reg_reg_reg(list: TAsmList; op: TOpCg;
  295. size: tcgsize; src1, src2, dst: tregister);
  296. var
  297. ovloc : tlocation;
  298. begin
  299. a_op_reg_reg_reg_checkoverflow(list,op,size,src1,src2,dst,false,ovloc);
  300. end;
  301. procedure tcgarm.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister;setflags : boolean;var ovloc : tlocation);
  302. var
  303. shift : byte;
  304. tmpreg : tregister;
  305. so : tshifterop;
  306. l1 : longint;
  307. begin
  308. ovloc.loc:=LOC_VOID;
  309. if is_shifter_const(-a,shift) then
  310. case op of
  311. OP_ADD:
  312. begin
  313. op:=OP_SUB;
  314. a:=dword(-a);
  315. end;
  316. OP_SUB:
  317. begin
  318. op:=OP_ADD;
  319. a:=dword(-a);
  320. end
  321. end;
  322. if is_shifter_const(a,shift) and not(op in [OP_IMUL,OP_MUL]) then
  323. case op of
  324. OP_NEG,OP_NOT,
  325. OP_DIV,OP_IDIV:
  326. internalerror(200308281);
  327. OP_SHL:
  328. begin
  329. if a>32 then
  330. internalerror(200308294);
  331. if a<>0 then
  332. begin
  333. shifterop_reset(so);
  334. so.shiftmode:=SM_LSL;
  335. so.shiftimm:=a;
  336. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src,so));
  337. end
  338. else
  339. list.concat(taicpu.op_reg_reg(A_MOV,dst,src));
  340. end;
  341. OP_SHR:
  342. begin
  343. if a>32 then
  344. internalerror(200308292);
  345. shifterop_reset(so);
  346. if a<>0 then
  347. begin
  348. so.shiftmode:=SM_LSR;
  349. so.shiftimm:=a;
  350. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src,so));
  351. end
  352. else
  353. list.concat(taicpu.op_reg_reg(A_MOV,dst,src));
  354. end;
  355. OP_SAR:
  356. begin
  357. if a>32 then
  358. internalerror(200308295);
  359. if a<>0 then
  360. begin
  361. shifterop_reset(so);
  362. so.shiftmode:=SM_ASR;
  363. so.shiftimm:=a;
  364. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src,so));
  365. end
  366. else
  367. list.concat(taicpu.op_reg_reg(A_MOV,dst,src));
  368. end;
  369. else
  370. list.concat(setoppostfix(
  371. taicpu.op_reg_reg_const(op_reg_reg_opcg2asmop[op],dst,src,a),toppostfix(ord(cgsetflags or setflags)*ord(PF_S))
  372. ));
  373. if (cgsetflags or setflags) and (size in [OS_8,OS_16,OS_32]) then
  374. begin
  375. ovloc.loc:=LOC_FLAGS;
  376. case op of
  377. OP_ADD:
  378. ovloc.resflags:=F_CS;
  379. OP_SUB:
  380. ovloc.resflags:=F_CC;
  381. end;
  382. end;
  383. end
  384. else
  385. begin
  386. { there could be added some more sophisticated optimizations }
  387. if (op in [OP_MUL,OP_IMUL]) and (a=1) then
  388. a_load_reg_reg(list,size,size,src,dst)
  389. else if (op in [OP_MUL,OP_IMUL]) and (a=0) then
  390. a_load_const_reg(list,size,0,dst)
  391. else if (op in [OP_IMUL]) and (a=-1) then
  392. a_op_reg_reg(list,OP_NEG,size,src,dst)
  393. { we do this here instead in the peephole optimizer because
  394. it saves us a register }
  395. else if (op in [OP_MUL,OP_IMUL]) and ispowerof2(a,l1) and not(cgsetflags or setflags) then
  396. a_op_const_reg_reg(list,OP_SHL,size,l1,src,dst)
  397. { for example : b=a*5 -> b=a*4+a with add instruction and shl }
  398. else if (op in [OP_MUL,OP_IMUL]) and ispowerof2(a-1,l1) and not(cgsetflags or setflags) then
  399. begin
  400. if l1>32 then{roozbeh does this ever happen?}
  401. internalerror(200308296);
  402. shifterop_reset(so);
  403. so.shiftmode:=SM_LSL;
  404. so.shiftimm:=l1;
  405. list.concat(taicpu.op_reg_reg_reg_shifterop(A_ADD,dst,src,src,so));
  406. end
  407. else
  408. begin
  409. tmpreg:=getintregister(list,size);
  410. a_load_const_reg(list,size,a,tmpreg);
  411. a_op_reg_reg_reg_checkoverflow(list,op,size,tmpreg,src,dst,setflags,ovloc);
  412. end;
  413. end;
  414. end;
  415. procedure tcgarm.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation);
  416. var
  417. so : tshifterop;
  418. tmpreg,overflowreg : tregister;
  419. asmop : tasmop;
  420. begin
  421. ovloc.loc:=LOC_VOID;
  422. case op of
  423. OP_NEG,OP_NOT,
  424. OP_DIV,OP_IDIV:
  425. internalerror(200308281);
  426. OP_SHL:
  427. begin
  428. shifterop_reset(so);
  429. so.rs:=src1;
  430. so.shiftmode:=SM_LSL;
  431. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src2,so));
  432. end;
  433. OP_SHR:
  434. begin
  435. shifterop_reset(so);
  436. so.rs:=src1;
  437. so.shiftmode:=SM_LSR;
  438. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src2,so));
  439. end;
  440. OP_SAR:
  441. begin
  442. shifterop_reset(so);
  443. so.rs:=src1;
  444. so.shiftmode:=SM_ASR;
  445. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src2,so));
  446. end;
  447. OP_IMUL,
  448. OP_MUL:
  449. begin
  450. if cgsetflags or setflags then
  451. begin
  452. overflowreg:=getintregister(list,size);
  453. if op=OP_IMUL then
  454. asmop:=A_SMULL
  455. else
  456. asmop:=A_UMULL;
  457. { the arm doesn't allow that rd and rm are the same }
  458. if dst=src2 then
  459. begin
  460. if dst<>src1 then
  461. list.concat(taicpu.op_reg_reg_reg_reg(asmop,dst,overflowreg,src1,src2))
  462. else
  463. begin
  464. tmpreg:=getintregister(list,size);
  465. a_load_reg_reg(list,size,size,src2,dst);
  466. list.concat(taicpu.op_reg_reg_reg_reg(asmop,dst,overflowreg,tmpreg,src1));
  467. end;
  468. end
  469. else
  470. list.concat(taicpu.op_reg_reg_reg_reg(asmop,dst,overflowreg,src2,src1));
  471. if op=OP_IMUL then
  472. begin
  473. shifterop_reset(so);
  474. so.shiftmode:=SM_ASR;
  475. so.shiftimm:=31;
  476. list.concat(taicpu.op_reg_reg_shifterop(A_CMP,overflowreg,dst,so));
  477. end
  478. else
  479. list.concat(taicpu.op_reg_const(A_CMP,overflowreg,0));
  480. ovloc.loc:=LOC_FLAGS;
  481. ovloc.resflags:=F_NE;
  482. end
  483. else
  484. begin
  485. { the arm doesn't allow that rd and rm are the same }
  486. if dst=src2 then
  487. begin
  488. if dst<>src1 then
  489. list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,src1,src2))
  490. else
  491. begin
  492. tmpreg:=getintregister(list,size);
  493. a_load_reg_reg(list,size,size,src2,dst);
  494. list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,tmpreg,src1));
  495. end;
  496. end
  497. else
  498. list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,src2,src1));
  499. end;
  500. end;
  501. else
  502. list.concat(setoppostfix(
  503. taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop[op],dst,src2,src1),toppostfix(ord(cgsetflags or setflags)*ord(PF_S))
  504. ));
  505. end;
  506. end;
  507. procedure tcgarm.a_load_const_reg(list : TAsmList; size: tcgsize; a : aint;reg : tregister);
  508. var
  509. imm_shift : byte;
  510. l : tasmlabel;
  511. hr : treference;
  512. begin
  513. if not(size in [OS_8,OS_S8,OS_16,OS_S16,OS_32,OS_S32]) then
  514. internalerror(2002090902);
  515. if is_shifter_const(a,imm_shift) then
  516. list.concat(taicpu.op_reg_const(A_MOV,reg,a))
  517. else if is_shifter_const(not(a),imm_shift) then
  518. list.concat(taicpu.op_reg_const(A_MVN,reg,not(a)))
  519. { loading of constants with mov and orr }
  520. {else [if (is_shifter_const(a-byte(a),imm_shift)) then
  521. begin
  522. }{ roozbeh:why using tmpreg later causes error in compiling of system.pp,and also those other similars}
  523. {list.concat(taicpu.op_reg_const(A_MOV,reg,a-byte(a)));
  524. list.concat(taicpu.op_reg_reg_const(A_ORR,reg,reg,byte(a)));
  525. end
  526. else if (is_shifter_const(a-word(a),imm_shift)) and (is_shifter_const(word(a),imm_shift)) then
  527. begin
  528. list.concat(taicpu.op_reg_const(A_MOV,reg,a-word(a)));
  529. list.concat(taicpu.op_reg_reg_const(A_ORR,reg,reg,word(a)));
  530. end
  531. else if (is_shifter_const(a-(longint(a) shl 8) shr 8,imm_shift)) and (is_shifter_const((longint(a) shl 8) shr 8,imm_shift)) then
  532. begin
  533. list.concat(taicpu.op_reg_const(A_MOV,reg,a-(longint(a) shl 8)shr 8));
  534. list.concat(taicpu.op_reg_reg_const(A_ORR,reg,reg,(longint(a) shl 8)shr 8));
  535. end}
  536. else
  537. begin
  538. reference_reset(hr);
  539. current_asmdata.getjumplabel(l);
  540. cg.a_label(current_procinfo.aktlocaldata,l);
  541. hr.symboldata:=current_procinfo.aktlocaldata.last;
  542. current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(longint(a)));
  543. hr.symbol:=l;
  544. list.concat(taicpu.op_reg_ref(A_LDR,reg,hr));
  545. end;
  546. end;
  547. function tcgarm.handle_load_store(list:TAsmList;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference):treference;
  548. var
  549. tmpreg : tregister;
  550. tmpref : treference;
  551. l : tasmlabel;
  552. begin
  553. tmpreg:=NR_NO;
  554. { Be sure to have a base register }
  555. if (ref.base=NR_NO) then
  556. begin
  557. if ref.shiftmode<>SM_None then
  558. internalerror(200308294);
  559. ref.base:=ref.index;
  560. ref.index:=NR_NO;
  561. end;
  562. { absolute symbols can't be handled directly, we've to store the symbol reference
  563. in the text segment and access it pc relative
  564. For now, we assume that references where base or index equals to PC are already
  565. relative, all other references are assumed to be absolute and thus they need
  566. to be handled extra.
  567. A proper solution would be to change refoptions to a set and store the information
  568. if the symbol is absolute or relative there.
  569. }
  570. if (assigned(ref.symbol) and
  571. not(is_pc(ref.base)) and
  572. not(is_pc(ref.index))
  573. ) or
  574. { [#xxx] isn't a valid address operand }
  575. ((ref.base=NR_NO) and (ref.index=NR_NO)) or
  576. (ref.offset<-4095) or
  577. (ref.offset>4095) or
  578. ((oppostfix in [PF_SB,PF_H,PF_SH]) and
  579. ((ref.offset<-255) or
  580. (ref.offset>255)
  581. )
  582. ) or
  583. ((op in [A_LDF,A_STF]) and
  584. ((ref.offset<-1020) or
  585. (ref.offset>1020) or
  586. { the usual pc relative symbol handling assumes possible offsets of +/- 4095 }
  587. assigned(ref.symbol)
  588. )
  589. ) then
  590. begin
  591. reference_reset(tmpref);
  592. { load symbol }
  593. tmpreg:=getintregister(list,OS_INT);
  594. if assigned(ref.symbol) then
  595. begin
  596. current_asmdata.getjumplabel(l);
  597. cg.a_label(current_procinfo.aktlocaldata,l);
  598. tmpref.symboldata:=current_procinfo.aktlocaldata.last;
  599. current_procinfo.aktlocaldata.concat(tai_const.create_sym_offset(ref.symbol,ref.offset));
  600. { load consts entry }
  601. tmpref.symbol:=l;
  602. tmpref.base:=NR_R15;
  603. list.concat(taicpu.op_reg_ref(A_LDR,tmpreg,tmpref));
  604. end
  605. else
  606. a_load_const_reg(list,OS_ADDR,ref.offset,tmpreg);
  607. if (ref.base<>NR_NO) then
  608. begin
  609. if ref.index<>NR_NO then
  610. begin
  611. list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
  612. ref.base:=tmpreg;
  613. end
  614. else
  615. begin
  616. ref.index:=tmpreg;
  617. ref.shiftimm:=0;
  618. ref.signindex:=1;
  619. ref.shiftmode:=SM_None;
  620. end;
  621. end
  622. else
  623. ref.base:=tmpreg;
  624. ref.offset:=0;
  625. ref.symbol:=nil;
  626. end;
  627. if (ref.base<>NR_NO) and (ref.index<>NR_NO) and (ref.offset<>0) then
  628. begin
  629. if tmpreg<>NR_NO then
  630. a_op_const_reg_reg(list,OP_ADD,OS_ADDR,ref.offset,tmpreg,tmpreg)
  631. else
  632. begin
  633. tmpreg:=getintregister(list,OS_ADDR);
  634. a_op_const_reg_reg(list,OP_ADD,OS_ADDR,ref.offset,ref.base,tmpreg);
  635. ref.base:=tmpreg;
  636. end;
  637. ref.offset:=0;
  638. end;
  639. { floating point operations have only limited references
  640. we expect here, that a base is already set }
  641. if (op in [A_LDF,A_STF]) and (ref.index<>NR_NO) then
  642. begin
  643. if ref.shiftmode<>SM_none then
  644. internalerror(200309121);
  645. if tmpreg<>NR_NO then
  646. begin
  647. if ref.base=tmpreg then
  648. begin
  649. if ref.signindex<0 then
  650. list.concat(taicpu.op_reg_reg_reg(A_SUB,tmpreg,tmpreg,ref.index))
  651. else
  652. list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,tmpreg,ref.index));
  653. ref.index:=NR_NO;
  654. end
  655. else
  656. begin
  657. if ref.index<>tmpreg then
  658. internalerror(200403161);
  659. if ref.signindex<0 then
  660. list.concat(taicpu.op_reg_reg_reg(A_SUB,tmpreg,ref.base,tmpreg))
  661. else
  662. list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
  663. ref.base:=tmpreg;
  664. ref.index:=NR_NO;
  665. end;
  666. end
  667. else
  668. begin
  669. tmpreg:=getintregister(list,OS_ADDR);
  670. list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,ref.index));
  671. ref.base:=tmpreg;
  672. ref.index:=NR_NO;
  673. end;
  674. end;
  675. list.concat(setoppostfix(taicpu.op_reg_ref(op,reg,ref),oppostfix));
  676. Result := ref;
  677. end;
  678. procedure tcgarm.a_load_reg_ref(list : TAsmList; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);
  679. var
  680. oppostfix:toppostfix;
  681. usedtmpref: treference;
  682. tmpreg : tregister;
  683. so : tshifterop;
  684. begin
  685. case ToSize of
  686. { signed integer registers }
  687. OS_8,
  688. OS_S8:
  689. oppostfix:=PF_B;
  690. OS_16,
  691. OS_S16:
  692. oppostfix:=PF_H;
  693. OS_32,
  694. OS_S32:
  695. oppostfix:=PF_None;
  696. else
  697. InternalError(200308295);
  698. end;
  699. if ref.alignment<>0 then
  700. begin
  701. case FromSize of
  702. OS_16,OS_S16:
  703. begin
  704. shifterop_reset(so);so.shiftmode:=SM_LSR;so.shiftimm:=8;
  705. tmpreg:=getintregister(list,OS_INT);
  706. usedtmpref:=a_internal_load_reg_ref(list,OS_8,OS_8,reg,Ref);
  707. inc(usedtmpref.offset);
  708. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,tmpreg,reg,so));
  709. a_internal_load_reg_ref(list,OS_8,OS_8,tmpreg,usedtmpref);
  710. end;
  711. OS_32,OS_S32:
  712. begin
  713. shifterop_reset(so);so.shiftmode:=SM_LSR;so.shiftimm:=8;
  714. tmpreg:=getintregister(list,OS_INT);
  715. usedtmpref:=a_internal_load_reg_ref(list,OS_8,OS_8,reg,Ref);
  716. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,tmpreg,reg,so));
  717. inc(usedtmpref.offset);
  718. a_internal_load_reg_ref(list,OS_8,OS_8,tmpreg,usedtmpref);
  719. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,tmpreg,tmpreg,so));
  720. inc(usedtmpref.offset);
  721. a_internal_load_reg_ref(list,OS_8,OS_8,tmpreg,usedtmpref);
  722. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,tmpreg,tmpreg,so));
  723. inc(usedtmpref.offset);
  724. a_internal_load_reg_ref(list,OS_8,OS_8,tmpreg,usedtmpref);
  725. end
  726. else
  727. handle_load_store(list,A_STR,oppostfix,reg,ref);
  728. end;
  729. end
  730. else
  731. handle_load_store(list,A_STR,oppostfix,reg,ref);
  732. end;
  733. procedure tcgarm.a_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);
  734. var
  735. oppostfix:toppostfix;
  736. usedtmpref: treference;
  737. tmpreg,tmpreg2,tmpreg3 : tregister;
  738. so : tshifterop;
  739. begin
  740. case FromSize of
  741. { signed integer registers }
  742. OS_8:
  743. oppostfix:=PF_B;
  744. OS_S8:
  745. oppostfix:=PF_SB;
  746. OS_16:
  747. oppostfix:=PF_H;
  748. OS_S16:
  749. oppostfix:=PF_SH;
  750. OS_32,
  751. OS_S32:
  752. oppostfix:=PF_None;
  753. else
  754. InternalError(200308297);
  755. end;
  756. if Ref.alignment<>0 then
  757. begin
  758. case FromSize of
  759. OS_16,OS_S16:
  760. begin
  761. tmpreg3:=getintregister(list,OS_INT);
  762. a_loadaddr_ref_reg(list,ref,tmpreg3);
  763. reference_reset_base(usedtmpref,tmpreg3,0);
  764. shifterop_reset(so);so.shiftmode:=SM_LSL;so.shiftimm:=8;
  765. tmpreg:=getintregister(list,OS_INT);
  766. a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg);
  767. inc(usedtmpref.offset);
  768. tmpreg2:=getintregister(list,OS_INT);
  769. if FromSize=OS_16 then
  770. a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg2)
  771. else
  772. a_internal_load_ref_reg(list,OS_S8,OS_S8,usedtmpref,tmpreg2);
  773. list.concat(taicpu.op_reg_reg_reg_shifterop(A_ORR,reg,tmpreg,tmpreg2,so));
  774. end;
  775. OS_32,OS_S32:
  776. begin
  777. tmpreg:=getintregister(list,OS_INT);
  778. tmpreg2:=getintregister(list,OS_INT);
  779. tmpreg3:=getintregister(list,OS_INT);
  780. shifterop_reset(so);so.shiftmode:=SM_LSL;so.shiftimm:=8;
  781. a_loadaddr_ref_reg(list,ref,tmpreg3);
  782. reference_reset_base(usedtmpref,tmpreg3,0);
  783. a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,reg);
  784. inc(usedtmpref.offset);
  785. a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg);
  786. list.concat(taicpu.op_reg_reg_reg_shifterop(A_ORR,tmpreg2,reg,tmpreg,so));
  787. inc(usedtmpref.offset);
  788. a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,reg);
  789. so.shiftimm:=16;
  790. list.concat(taicpu.op_reg_reg_reg_shifterop(A_ORR,tmpreg,tmpreg2,reg,so));
  791. inc(usedtmpref.offset);
  792. a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg2);
  793. so.shiftimm:=24;
  794. list.concat(taicpu.op_reg_reg_reg_shifterop(A_ORR,reg,tmpreg,tmpreg2,so));
  795. end
  796. else
  797. handle_load_store(list,A_LDR,oppostfix,reg,ref);
  798. end;
  799. end
  800. else
  801. handle_load_store(list,A_LDR,oppostfix,reg,ref);
  802. end;
  803. function tcgarm.a_internal_load_reg_ref(list : TAsmList; fromsize, tosize: tcgsize; reg : tregister;const ref : treference):treference;
  804. var
  805. oppostfix:toppostfix;
  806. begin
  807. case ToSize of
  808. { signed integer registers }
  809. OS_8,
  810. OS_S8:
  811. oppostfix:=PF_B;
  812. OS_16,
  813. OS_S16:
  814. oppostfix:=PF_H;
  815. OS_32,
  816. OS_S32:
  817. oppostfix:=PF_None;
  818. else
  819. InternalError(2003082910);
  820. end;
  821. result:=handle_load_store(list,A_STR,oppostfix,reg,ref);
  822. end;
  823. function tcgarm.a_internal_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister):treference;
  824. var
  825. oppostfix:toppostfix;
  826. begin
  827. case FromSize of
  828. { signed integer registers }
  829. OS_8:
  830. oppostfix:=PF_B;
  831. OS_S8:
  832. oppostfix:=PF_SB;
  833. OS_16:
  834. oppostfix:=PF_H;
  835. OS_S16:
  836. oppostfix:=PF_SH;
  837. OS_32,
  838. OS_S32:
  839. oppostfix:=PF_None;
  840. else
  841. InternalError(200308291);
  842. end;
  843. result:=handle_load_store(list,A_LDR,oppostfix,reg,ref);
  844. end;
  845. procedure tcgarm.a_load_reg_reg(list : TAsmList; fromsize, tosize : tcgsize;reg1,reg2 : tregister);
  846. var
  847. so : tshifterop;
  848. conv_done: boolean;
  849. procedure do_shift(shiftmode : tshiftmode; shiftimm : byte; reg : tregister);
  850. begin
  851. so.shiftmode:=shiftmode;
  852. so.shiftimm:=shiftimm;
  853. list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg,so));
  854. end;
  855. function do_conv(size : tcgsize) : boolean;
  856. begin
  857. result:=true;
  858. case size of
  859. OS_8:
  860. list.concat(taicpu.op_reg_reg_const(A_AND,reg2,reg1,$ff));
  861. OS_S8:
  862. begin
  863. do_shift(SM_LSL,24,reg1);
  864. do_shift(SM_ASR,24,reg2);
  865. end;
  866. OS_16,OS_S16:
  867. begin
  868. do_shift(SM_LSL,16,reg1);
  869. if size=OS_S16 then
  870. do_shift(SM_ASR,16,reg2)
  871. else
  872. do_shift(SM_LSR,16,reg2);
  873. end;
  874. else
  875. result:=false;
  876. end;
  877. conv_done:=result;
  878. end;
  879. var
  880. instr: taicpu;
  881. begin
  882. conv_done:=false;
  883. if tcgsize2size[tosize]<>tcgsize2size[fromsize] then
  884. begin
  885. shifterop_reset(so);
  886. if not do_conv(tosize) then
  887. if tosize in [OS_32,OS_S32] then
  888. do_conv(fromsize)
  889. else
  890. internalerror(2002090901);
  891. end;
  892. if not conv_done and (reg1<>reg2) then
  893. begin
  894. { same size, only a register mov required }
  895. instr:=taicpu.op_reg_reg(A_MOV,reg2,reg1);
  896. list.Concat(instr);
  897. { Notify the register allocator that we have written a move instruction so
  898. it can try to eliminate it. }
  899. add_move_instruction(instr);
  900. end;
  901. end;
  902. procedure tcgarm.a_paramfpu_ref(list : TAsmList;size : tcgsize;const ref : treference;const paraloc : TCGPara);
  903. var
  904. href,href2 : treference;
  905. hloc : pcgparalocation;
  906. begin
  907. href:=ref;
  908. hloc:=paraloc.location;
  909. while assigned(hloc) do
  910. begin
  911. case hloc^.loc of
  912. LOC_FPUREGISTER,LOC_CFPUREGISTER:
  913. a_loadfpu_ref_reg(list,size,size,ref,hloc^.register);
  914. LOC_REGISTER :
  915. case hloc^.size of
  916. OS_F32:
  917. a_load_ref_reg(list,OS_32,OS_32,href,hloc^.register);
  918. OS_64,
  919. OS_F64:
  920. cg64.a_param64_ref(list,href,paraloc);
  921. else
  922. a_load_ref_reg(list,hloc^.size,hloc^.size,href,hloc^.register);
  923. end;
  924. LOC_REFERENCE :
  925. begin
  926. reference_reset_base(href2,hloc^.reference.index,hloc^.reference.offset);
  927. { concatcopy should choose the best way to copy the data }
  928. g_concatcopy(list,href,href2,tcgsize2size[size]);
  929. end;
  930. else
  931. internalerror(200408241);
  932. end;
  933. inc(href.offset,tcgsize2size[hloc^.size]);
  934. hloc:=hloc^.next;
  935. end;
  936. end;
  937. procedure tcgarm.a_loadfpu_reg_reg(list: TAsmList; fromsize,tosize: tcgsize; reg1, reg2: tregister);
  938. begin
  939. list.concat(setoppostfix(taicpu.op_reg_reg(A_MVF,reg2,reg1),cgsize2fpuoppostfix[tosize]));
  940. end;
  941. procedure tcgarm.a_loadfpu_ref_reg(list: TAsmList; fromsize,tosize: tcgsize; const ref: treference; reg: tregister);
  942. var
  943. oppostfix:toppostfix;
  944. begin
  945. case tosize of
  946. OS_32,
  947. OS_F32:
  948. oppostfix:=PF_S;
  949. OS_64,
  950. OS_F64:
  951. oppostfix:=PF_D;
  952. OS_F80:
  953. oppostfix:=PF_E;
  954. else
  955. InternalError(200309021);
  956. end;
  957. handle_load_store(list,A_LDF,oppostfix,reg,ref);
  958. end;
  959. procedure tcgarm.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference);
  960. var
  961. oppostfix:toppostfix;
  962. begin
  963. case tosize of
  964. OS_F32:
  965. oppostfix:=PF_S;
  966. OS_F64:
  967. oppostfix:=PF_D;
  968. OS_F80:
  969. oppostfix:=PF_E;
  970. else
  971. InternalError(200309022);
  972. end;
  973. handle_load_store(list,A_STF,oppostfix,reg,ref);
  974. end;
  975. { comparison operations }
  976. procedure tcgarm.a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : aint;reg : tregister;
  977. l : tasmlabel);
  978. var
  979. tmpreg : tregister;
  980. b : byte;
  981. begin
  982. if is_shifter_const(a,b) then
  983. list.concat(taicpu.op_reg_const(A_CMP,reg,a))
  984. { CMN reg,0 and CMN reg,$80000000 are different from CMP reg,$ffffffff
  985. and CMP reg,$7fffffff regarding the flags according to the ARM manual }
  986. else if (a<>$7fffffff) and (a<>-1) and is_shifter_const(-a,b) then
  987. list.concat(taicpu.op_reg_const(A_CMN,reg,-a))
  988. else
  989. begin
  990. tmpreg:=getintregister(list,size);
  991. a_load_const_reg(list,size,a,tmpreg);
  992. list.concat(taicpu.op_reg_reg(A_CMP,reg,tmpreg));
  993. end;
  994. a_jmp_cond(list,cmp_op,l);
  995. end;
  996. procedure tcgarm.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
  997. begin
  998. list.concat(taicpu.op_reg_reg(A_CMP,reg2,reg1));
  999. a_jmp_cond(list,cmp_op,l);
  1000. end;
  1001. procedure tcgarm.a_jmp_name(list : TAsmList;const s : string);
  1002. var
  1003. ai : taicpu;
  1004. begin
  1005. ai:=taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(s));
  1006. ai.is_jmp:=true;
  1007. list.concat(ai);
  1008. end;
  1009. procedure tcgarm.a_jmp_always(list : TAsmList;l: tasmlabel);
  1010. var
  1011. ai : taicpu;
  1012. begin
  1013. ai:=taicpu.op_sym(A_B,l);
  1014. ai.is_jmp:=true;
  1015. list.concat(ai);
  1016. end;
  1017. procedure tcgarm.a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel);
  1018. var
  1019. ai : taicpu;
  1020. begin
  1021. ai:=setcondition(taicpu.op_sym(A_B,l),flags_to_cond(f));
  1022. ai.is_jmp:=true;
  1023. list.concat(ai);
  1024. end;
  1025. procedure tcgarm.g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister);
  1026. begin
  1027. list.concat(setcondition(taicpu.op_reg_const(A_MOV,reg,1),flags_to_cond(f)));
  1028. list.concat(setcondition(taicpu.op_reg_const(A_MOV,reg,0),inverse_cond(flags_to_cond(f))));
  1029. end;
  1030. procedure tcgarm.g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);
  1031. var
  1032. ref : treference;
  1033. shift : byte;
  1034. firstfloatreg,lastfloatreg,
  1035. r : byte;
  1036. regs : tcpuregisterset;
  1037. begin
  1038. LocalSize:=align(LocalSize,4);
  1039. if not(nostackframe) then
  1040. begin
  1041. firstfloatreg:=RS_NO;
  1042. { save floating point registers? }
  1043. for r:=RS_F0 to RS_F7 do
  1044. if r in rg[R_FPUREGISTER].used_in_proc-paramanager.get_volatile_registers_fpu(pocall_stdcall) then
  1045. begin
  1046. if firstfloatreg=RS_NO then
  1047. firstfloatreg:=r;
  1048. lastfloatreg:=r;
  1049. end;
  1050. a_reg_alloc(list,NR_STACK_POINTER_REG);
  1051. if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
  1052. begin
  1053. a_reg_alloc(list,NR_FRAME_POINTER_REG);
  1054. a_reg_alloc(list,NR_R12);
  1055. list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_STACK_POINTER_REG));
  1056. end;
  1057. { save int registers }
  1058. reference_reset(ref);
  1059. ref.index:=NR_STACK_POINTER_REG;
  1060. ref.addressmode:=AM_PREINDEXED;
  1061. regs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall);
  1062. if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
  1063. regs:=regs+[RS_R11,RS_R12,RS_R14,RS_R15]
  1064. else
  1065. if (regs<>[]) or (pi_do_call in current_procinfo.flags) then
  1066. include(regs,RS_R14);
  1067. if regs<>[] then
  1068. list.concat(setoppostfix(taicpu.op_ref_regset(A_STM,ref,regs),PF_FD));
  1069. if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
  1070. list.concat(taicpu.op_reg_reg_const(A_SUB,NR_FRAME_POINTER_REG,NR_R12,4));
  1071. { allocate necessary stack size
  1072. not necessary according to Yury Sidorov
  1073. { don't use a_op_const_reg_reg here because we don't allow register allocations
  1074. in the entry/exit code }
  1075. if (target_info.system in [system_arm_wince]) and
  1076. (localsize>=winstackpagesize) then
  1077. begin
  1078. if localsize div winstackpagesize<=5 then
  1079. begin
  1080. if is_shifter_const(localsize,shift) then
  1081. list.concat(Taicpu.op_reg_reg_const(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,localsize))
  1082. else
  1083. begin
  1084. a_load_const_reg(list,OS_ADDR,localsize,NR_R12);
  1085. list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,NR_R12));
  1086. end;
  1087. for i:=1 to localsize div winstackpagesize do
  1088. begin
  1089. if localsize-i*winstackpagesize<4096 then
  1090. reference_reset_base(href,NR_STACK_POINTER_REG,-(localsize-i*winstackpagesize))
  1091. else
  1092. begin
  1093. a_load_const_reg(list,OS_ADDR,-(localsize-i*winstackpagesize),NR_R12);
  1094. reference_reset_base(href,NR_STACK_POINTER_REG,0);
  1095. href.index:=NR_R12;
  1096. end;
  1097. { the data stored doesn't matter }
  1098. list.concat(Taicpu.op_reg_ref(A_STR,NR_R0,href));
  1099. end;
  1100. a_reg_dealloc(list,NR_R12);
  1101. reference_reset_base(href,NR_STACK_POINTER_REG,0);
  1102. { the data stored doesn't matter }
  1103. list.concat(Taicpu.op_reg_ref(A_STR,NR_R0,href));
  1104. end
  1105. else
  1106. begin
  1107. current_asmdata.getjumplabel(again);
  1108. list.concat(Taicpu.op_reg_const(A_MOV,NR_R12,localsize div winstackpagesize));
  1109. a_label(list,again);
  1110. { always shifterop }
  1111. list.concat(Taicpu.op_reg_reg_const(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,winstackpagesize));
  1112. reference_reset_base(href,NR_STACK_POINTER_REG,0);
  1113. { the data stored doesn't matter }
  1114. list.concat(Taicpu.op_reg_ref(A_STR,NR_R0,href));
  1115. list.concat(Taicpu.op_reg_reg_const(A_SUB,NR_R12,NR_R12,1));
  1116. a_jmp_cond(list,OC_NE,again);
  1117. if is_shifter_const(localsize mod winstackpagesize,shift) then
  1118. list.concat(Taicpu.op_reg_reg_const(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,localsize mod winstackpagesize))
  1119. else
  1120. begin
  1121. a_load_const_reg(list,OS_ADDR,localsize mod winstackpagesize,NR_R12);
  1122. list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,NR_R12));
  1123. end;
  1124. a_reg_dealloc(list,NR_R12);
  1125. reference_reset_base(href,NR_STACK_POINTER_REG,0);
  1126. { the data stored doesn't matter }
  1127. list.concat(Taicpu.op_reg_ref(A_STR,NR_R0,href));
  1128. end
  1129. end
  1130. else
  1131. }
  1132. if LocalSize<>0 then
  1133. if not(is_shifter_const(localsize,shift)) then
  1134. begin
  1135. if current_procinfo.framepointer=NR_STACK_POINTER_REG then
  1136. a_reg_alloc(list,NR_R12);
  1137. a_load_const_reg(list,OS_ADDR,LocalSize,NR_R12);
  1138. list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,NR_R12));
  1139. a_reg_dealloc(list,NR_R12);
  1140. end
  1141. else
  1142. begin
  1143. a_reg_dealloc(list,NR_R12);
  1144. list.concat(taicpu.op_reg_reg_const(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,LocalSize));
  1145. end;
  1146. if firstfloatreg<>RS_NO then
  1147. begin
  1148. reference_reset(ref);
  1149. if tarmprocinfo(current_procinfo).floatregstart<=-1023 then
  1150. begin
  1151. a_load_const_reg(list,OS_ADDR,-tarmprocinfo(current_procinfo).floatregstart,NR_R12);
  1152. list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_R12,NR_FRAME_POINTER_REG,NR_R12));
  1153. ref.base:=NR_R12;
  1154. end
  1155. else
  1156. begin
  1157. ref.base:=NR_FRAME_POINTER_REG;
  1158. ref.offset:=tarmprocinfo(current_procinfo).floatregstart;
  1159. end;
  1160. list.concat(taicpu.op_reg_const_ref(A_SFM,newreg(R_FPUREGISTER,firstfloatreg,R_SUBWHOLE),
  1161. lastfloatreg-firstfloatreg+1,ref));
  1162. end;
  1163. end;
  1164. end;
  1165. procedure tcgarm.g_proc_exit(list : TAsmList;parasize : longint;nostackframe:boolean);
  1166. var
  1167. ref : treference;
  1168. firstfloatreg,lastfloatreg,
  1169. r : byte;
  1170. shift : byte;
  1171. regs : tcpuregisterset;
  1172. LocalSize : longint;
  1173. begin
  1174. if not(nostackframe) then
  1175. begin
  1176. { restore floating point register }
  1177. firstfloatreg:=RS_NO;
  1178. { save floating point registers? }
  1179. for r:=RS_F0 to RS_F7 do
  1180. if r in rg[R_FPUREGISTER].used_in_proc-paramanager.get_volatile_registers_fpu(pocall_stdcall) then
  1181. begin
  1182. if firstfloatreg=RS_NO then
  1183. firstfloatreg:=r;
  1184. lastfloatreg:=r;
  1185. end;
  1186. if firstfloatreg<>RS_NO then
  1187. begin
  1188. reference_reset(ref);
  1189. if tarmprocinfo(current_procinfo).floatregstart<=-1023 then
  1190. begin
  1191. a_load_const_reg(list,OS_ADDR,-tarmprocinfo(current_procinfo).floatregstart,NR_R12);
  1192. list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_R12,NR_FRAME_POINTER_REG,NR_R12));
  1193. ref.base:=NR_R12;
  1194. end
  1195. else
  1196. begin
  1197. ref.base:=NR_FRAME_POINTER_REG;
  1198. ref.offset:=tarmprocinfo(current_procinfo).floatregstart;
  1199. end;
  1200. list.concat(taicpu.op_reg_const_ref(A_LFM,newreg(R_FPUREGISTER,firstfloatreg,R_SUBWHOLE),
  1201. lastfloatreg-firstfloatreg+1,ref));
  1202. end;
  1203. if (current_procinfo.framepointer=NR_STACK_POINTER_REG) then
  1204. begin
  1205. LocalSize:=current_procinfo.calc_stackframe_size;
  1206. if LocalSize<>0 then
  1207. if not(is_shifter_const(LocalSize,shift)) then
  1208. begin
  1209. a_reg_alloc(list,NR_R12);
  1210. a_load_const_reg(list,OS_ADDR,LocalSize,NR_R12);
  1211. list.concat(taicpu.op_reg_reg_reg(A_ADD,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,NR_R12));
  1212. a_reg_dealloc(list,NR_R12);
  1213. end
  1214. else
  1215. begin
  1216. list.concat(taicpu.op_reg_reg_const(A_ADD,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,LocalSize));
  1217. end;
  1218. regs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall);
  1219. if (pi_do_call in current_procinfo.flags) or (regs<>[]) then
  1220. begin
  1221. exclude(regs,RS_R14);
  1222. include(regs,RS_R15);
  1223. end;
  1224. if regs=[] then
  1225. list.concat(taicpu.op_reg_reg(A_MOV,NR_R15,NR_R14))
  1226. else
  1227. begin
  1228. reference_reset(ref);
  1229. ref.index:=NR_STACK_POINTER_REG;
  1230. ref.addressmode:=AM_PREINDEXED;
  1231. list.concat(setoppostfix(taicpu.op_ref_regset(A_LDM,ref,regs),PF_FD));
  1232. end;
  1233. end
  1234. else
  1235. begin
  1236. { restore int registers and return }
  1237. reference_reset(ref);
  1238. ref.index:=NR_FRAME_POINTER_REG;
  1239. list.concat(setoppostfix(taicpu.op_ref_regset(A_LDM,ref,rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall)+[RS_R11,RS_R13,RS_R15]),PF_EA));
  1240. end;
  1241. end
  1242. else
  1243. list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R14));
  1244. end;
  1245. procedure tcgarm.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);
  1246. var
  1247. b : byte;
  1248. tmpref : treference;
  1249. instr : taicpu;
  1250. begin
  1251. if ref.addressmode<>AM_OFFSET then
  1252. internalerror(200309071);
  1253. tmpref:=ref;
  1254. { Be sure to have a base register }
  1255. if (tmpref.base=NR_NO) then
  1256. begin
  1257. if tmpref.shiftmode<>SM_None then
  1258. internalerror(200308294);
  1259. if tmpref.signindex<0 then
  1260. internalerror(200312023);
  1261. tmpref.base:=tmpref.index;
  1262. tmpref.index:=NR_NO;
  1263. end;
  1264. if assigned(tmpref.symbol) or
  1265. not((is_shifter_const(tmpref.offset,b)) or
  1266. (is_shifter_const(-tmpref.offset,b))
  1267. ) then
  1268. fixref(list,tmpref);
  1269. { expect a base here if there is an index }
  1270. if (tmpref.base=NR_NO) and (tmpref.index<>NR_NO) then
  1271. internalerror(200312022);
  1272. if tmpref.index<>NR_NO then
  1273. begin
  1274. if tmpref.shiftmode<>SM_None then
  1275. internalerror(200312021);
  1276. if tmpref.signindex<0 then
  1277. a_op_reg_reg_reg(list,OP_SUB,OS_ADDR,tmpref.base,tmpref.index,r)
  1278. else
  1279. a_op_reg_reg_reg(list,OP_ADD,OS_ADDR,tmpref.base,tmpref.index,r);
  1280. if tmpref.offset<>0 then
  1281. a_op_const_reg_reg(list,OP_ADD,OS_ADDR,tmpref.offset,r,r);
  1282. end
  1283. else
  1284. begin
  1285. if tmpref.base=NR_NO then
  1286. a_load_const_reg(list,OS_ADDR,tmpref.offset,r)
  1287. else
  1288. if tmpref.offset<>0 then
  1289. a_op_const_reg_reg(list,OP_ADD,OS_ADDR,tmpref.offset,tmpref.base,r)
  1290. else
  1291. begin
  1292. instr:=taicpu.op_reg_reg(A_MOV,r,tmpref.base);
  1293. list.concat(instr);
  1294. add_move_instruction(instr);
  1295. end;
  1296. end;
  1297. end;
  1298. procedure tcgarm.fixref(list : TAsmList;var ref : treference);
  1299. var
  1300. tmpreg : tregister;
  1301. tmpref : treference;
  1302. l : tasmlabel;
  1303. begin
  1304. { absolute symbols can't be handled directly, we've to store the symbol reference
  1305. in the text segment and access it pc relative
  1306. For now, we assume that references where base or index equals to PC are already
  1307. relative, all other references are assumed to be absolute and thus they need
  1308. to be handled extra.
  1309. A proper solution would be to change refoptions to a set and store the information
  1310. if the symbol is absolute or relative there.
  1311. }
  1312. { create consts entry }
  1313. reference_reset(tmpref);
  1314. current_asmdata.getjumplabel(l);
  1315. cg.a_label(current_procinfo.aktlocaldata,l);
  1316. tmpref.symboldata:=current_procinfo.aktlocaldata.last;
  1317. if assigned(ref.symbol) then
  1318. current_procinfo.aktlocaldata.concat(tai_const.create_sym_offset(ref.symbol,ref.offset))
  1319. else
  1320. current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(ref.offset));
  1321. { load consts entry }
  1322. tmpreg:=getintregister(list,OS_INT);
  1323. tmpref.symbol:=l;
  1324. tmpref.base:=NR_PC;
  1325. list.concat(taicpu.op_reg_ref(A_LDR,tmpreg,tmpref));
  1326. if (ref.base<>NR_NO) then
  1327. begin
  1328. if ref.index<>NR_NO then
  1329. begin
  1330. list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
  1331. ref.base:=tmpreg;
  1332. end
  1333. else
  1334. if ref.base<>NR_PC then
  1335. begin
  1336. ref.index:=tmpreg;
  1337. ref.shiftimm:=0;
  1338. ref.signindex:=1;
  1339. ref.shiftmode:=SM_None;
  1340. end
  1341. else
  1342. ref.base:=tmpreg;
  1343. end
  1344. else
  1345. ref.base:=tmpreg;
  1346. ref.offset:=0;
  1347. ref.symbol:=nil;
  1348. end;
  1349. procedure tcgarm.g_concatcopy_move(list : TAsmList;const source,dest : treference;len : aint);
  1350. var
  1351. paraloc1,paraloc2,paraloc3 : TCGPara;
  1352. begin
  1353. paraloc1.init;
  1354. paraloc2.init;
  1355. paraloc3.init;
  1356. paramanager.getintparaloc(pocall_default,1,paraloc1);
  1357. paramanager.getintparaloc(pocall_default,2,paraloc2);
  1358. paramanager.getintparaloc(pocall_default,3,paraloc3);
  1359. paramanager.allocparaloc(list,paraloc3);
  1360. a_param_const(list,OS_INT,len,paraloc3);
  1361. paramanager.allocparaloc(list,paraloc2);
  1362. a_paramaddr_ref(list,dest,paraloc2);
  1363. paramanager.allocparaloc(list,paraloc2);
  1364. a_paramaddr_ref(list,source,paraloc1);
  1365. paramanager.freeparaloc(list,paraloc3);
  1366. paramanager.freeparaloc(list,paraloc2);
  1367. paramanager.freeparaloc(list,paraloc1);
  1368. alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1369. alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
  1370. a_call_name(list,'FPC_MOVE');
  1371. dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
  1372. dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
  1373. paraloc3.done;
  1374. paraloc2.done;
  1375. paraloc1.done;
  1376. end;
  1377. procedure tcgarm.g_concatcopy_internal(list : TAsmList;const source,dest : treference;len : aint;aligned : boolean);
  1378. const
  1379. maxtmpreg=10;{roozbeh: can be reduced to 8 or lower if might conflick with reserved ones,also +2 is used becouse of regs required for referencing}
  1380. var
  1381. srcref,dstref,usedtmpref,usedtmpref2:treference;
  1382. srcreg,destreg,countreg,r,tmpreg:tregister;
  1383. helpsize:aint;
  1384. copysize:byte;
  1385. cgsize:Tcgsize;
  1386. tmpregisters:array[1..maxtmpreg]of tregister;
  1387. tmpregi,tmpregi2:byte;
  1388. { will never be called with count<=4 }
  1389. procedure genloop(count : aword;size : byte);
  1390. const
  1391. size2opsize : array[1..4] of tcgsize = (OS_8,OS_16,OS_NO,OS_32);
  1392. var
  1393. l : tasmlabel;
  1394. begin
  1395. current_asmdata.getjumplabel(l);
  1396. if count<size then size:=1;
  1397. a_load_const_reg(list,OS_INT,count div size,countreg);
  1398. cg.a_label(list,l);
  1399. srcref.addressmode:=AM_POSTINDEXED;
  1400. dstref.addressmode:=AM_POSTINDEXED;
  1401. srcref.offset:=size;
  1402. dstref.offset:=size;
  1403. r:=getintregister(list,size2opsize[size]);
  1404. a_load_ref_reg(list,size2opsize[size],size2opsize[size],srcref,r);
  1405. list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,countreg,countreg,1),PF_S));
  1406. a_load_reg_ref(list,size2opsize[size],size2opsize[size],r,dstref);
  1407. a_jmp_flags(list,F_NE,l);
  1408. srcref.offset:=1;
  1409. dstref.offset:=1;
  1410. case count mod size of
  1411. 1:
  1412. begin
  1413. a_load_ref_reg(list,OS_8,OS_8,srcref,r);
  1414. a_load_reg_ref(list,OS_8,OS_8,r,dstref);
  1415. end;
  1416. 2:
  1417. if aligned then
  1418. begin
  1419. a_load_ref_reg(list,OS_16,OS_16,srcref,r);
  1420. a_load_reg_ref(list,OS_16,OS_16,r,dstref);
  1421. end
  1422. else
  1423. begin
  1424. a_load_ref_reg(list,OS_8,OS_8,srcref,r);
  1425. a_load_reg_ref(list,OS_8,OS_8,r,dstref);
  1426. a_load_ref_reg(list,OS_8,OS_8,srcref,r);
  1427. a_load_reg_ref(list,OS_8,OS_8,r,dstref);
  1428. end;
  1429. 3:
  1430. if aligned then
  1431. begin
  1432. srcref.offset:=2;
  1433. dstref.offset:=2;
  1434. a_load_ref_reg(list,OS_16,OS_16,srcref,r);
  1435. a_load_reg_ref(list,OS_16,OS_16,r,dstref);
  1436. a_load_ref_reg(list,OS_8,OS_8,srcref,r);
  1437. a_load_reg_ref(list,OS_8,OS_8,r,dstref);
  1438. end
  1439. else
  1440. begin
  1441. a_load_ref_reg(list,OS_8,OS_8,srcref,r);
  1442. a_load_reg_ref(list,OS_8,OS_8,r,dstref);
  1443. a_load_ref_reg(list,OS_8,OS_8,srcref,r);
  1444. a_load_reg_ref(list,OS_8,OS_8,r,dstref);
  1445. a_load_ref_reg(list,OS_8,OS_8,srcref,r);
  1446. a_load_reg_ref(list,OS_8,OS_8,r,dstref);
  1447. end;
  1448. end;
  1449. { keep the registers alive }
  1450. list.concat(taicpu.op_reg_reg(A_MOV,countreg,countreg));
  1451. list.concat(taicpu.op_reg_reg(A_MOV,srcreg,srcreg));
  1452. list.concat(taicpu.op_reg_reg(A_MOV,destreg,destreg));
  1453. end;
  1454. begin
  1455. if len=0 then
  1456. exit;
  1457. helpsize:=12+maxtmpreg*4;//52 with maxtmpreg=10
  1458. dstref:=dest;
  1459. srcref:=source;
  1460. if cs_opt_size in current_settings.optimizerswitches then
  1461. helpsize:=8;
  1462. if (len<=helpsize) and aligned then
  1463. begin
  1464. tmpregi:=0;
  1465. srcreg:=getintregister(list,OS_ADDR);
  1466. { explicit pc relative addressing, could be
  1467. e.g. a floating point constant }
  1468. if source.base=NR_PC then
  1469. begin
  1470. { ... then we don't need a loadaddr }
  1471. srcref:=source;
  1472. end
  1473. else
  1474. begin
  1475. a_loadaddr_ref_reg(list,source,srcreg);
  1476. reference_reset_base(srcref,srcreg,0);
  1477. end;
  1478. while (len div 4 <> 0) and (tmpregi<=maxtmpreg) do
  1479. begin
  1480. inc(tmpregi);
  1481. tmpregisters[tmpregi]:=getintregister(list,OS_32);
  1482. a_load_ref_reg(list,OS_32,OS_32,srcref,tmpregisters[tmpregi]);
  1483. inc(srcref.offset,4);
  1484. dec(len,4);
  1485. end;
  1486. destreg:=getintregister(list,OS_ADDR);
  1487. a_loadaddr_ref_reg(list,dest,destreg);
  1488. reference_reset_base(dstref,destreg,0);
  1489. tmpregi2:=1;
  1490. while (tmpregi2<=tmpregi) do
  1491. begin
  1492. a_load_reg_ref(list,OS_32,OS_32,tmpregisters[tmpregi2],dstref);
  1493. inc(dstref.offset,4);
  1494. inc(tmpregi2);
  1495. end;
  1496. copysize:=4;
  1497. cgsize:=OS_32;
  1498. while len<>0 do
  1499. begin
  1500. if len<2 then
  1501. begin
  1502. copysize:=1;
  1503. cgsize:=OS_8;
  1504. end
  1505. else if len<4 then
  1506. begin
  1507. copysize:=2;
  1508. cgsize:=OS_16;
  1509. end;
  1510. dec(len,copysize);
  1511. r:=getintregister(list,cgsize);
  1512. a_load_ref_reg(list,cgsize,cgsize,srcref,r);
  1513. a_load_reg_ref(list,cgsize,cgsize,r,dstref);
  1514. inc(srcref.offset,copysize);
  1515. inc(dstref.offset,copysize);
  1516. end;{end of while}
  1517. end
  1518. else
  1519. begin
  1520. cgsize:=OS_32;
  1521. if (len<=4) then{len<=4 and not aligned}
  1522. begin
  1523. r:=getintregister(list,cgsize);
  1524. usedtmpref:=a_internal_load_ref_reg(list,OS_8,OS_8,srcref,r);
  1525. if Len=1 then
  1526. a_load_reg_ref(list,OS_8,OS_8,r,dstref)
  1527. else
  1528. begin
  1529. tmpreg:=getintregister(list,cgsize);
  1530. usedtmpref2:=a_internal_load_reg_ref(list,OS_8,OS_8,r,dstref);
  1531. inc(usedtmpref.offset,1);
  1532. a_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg);
  1533. inc(usedtmpref2.offset,1);
  1534. a_load_reg_ref(list,OS_8,OS_8,tmpreg,usedtmpref2);
  1535. if len>2 then
  1536. begin
  1537. inc(usedtmpref.offset,1);
  1538. a_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg);
  1539. inc(usedtmpref2.offset,1);
  1540. a_load_reg_ref(list,OS_8,OS_8,tmpreg,usedtmpref2);
  1541. if len>3 then
  1542. begin
  1543. inc(usedtmpref.offset,1);
  1544. a_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg);
  1545. inc(usedtmpref2.offset,1);
  1546. a_load_reg_ref(list,OS_8,OS_8,tmpreg,usedtmpref2);
  1547. end;
  1548. end;
  1549. end;
  1550. end{end of if len<=4}
  1551. else
  1552. begin{unaligned & 4<len<helpsize **or** aligned/unaligned & len>helpsize}
  1553. destreg:=getintregister(list,OS_ADDR);
  1554. a_loadaddr_ref_reg(list,dest,destreg);
  1555. reference_reset_base(dstref,destreg,0);
  1556. srcreg:=getintregister(list,OS_ADDR);
  1557. a_loadaddr_ref_reg(list,source,srcreg);
  1558. reference_reset_base(srcref,srcreg,0);
  1559. countreg:=getintregister(list,OS_32);
  1560. // if cs_opt_size in current_settings.optimizerswitches then
  1561. { roozbeh : it seems loading 1 byte is faster becouse of caching/fetching(?) }
  1562. {if aligned then
  1563. genloop(len,4)
  1564. else}
  1565. genloop(len,1);
  1566. end;
  1567. end;
  1568. end;
  1569. procedure tcgarm.g_concatcopy_unaligned(list : TAsmList;const source,dest : treference;len : aint);
  1570. begin
  1571. g_concatcopy_internal(list,source,dest,len,false);
  1572. end;
  1573. procedure tcgarm.g_concatcopy(list : TAsmList;const source,dest : treference;len : aint);
  1574. begin
  1575. if (source.alignment in [1..3]) or
  1576. (dest.alignment in [1..3]) then
  1577. g_concatcopy_internal(list,source,dest,len,false)
  1578. else
  1579. g_concatcopy_internal(list,source,dest,len,true);
  1580. end;
  1581. procedure tcgarm.g_overflowCheck(list : TAsmList;const l : tlocation;def : tdef);
  1582. var
  1583. ovloc : tlocation;
  1584. begin
  1585. ovloc.loc:=LOC_VOID;
  1586. g_overflowCheck_loc(list,l,def,ovloc);
  1587. end;
  1588. procedure tcgarm.g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation);
  1589. var
  1590. hl : tasmlabel;
  1591. ai:TAiCpu;
  1592. hflags : tresflags;
  1593. begin
  1594. if not(cs_check_overflow in current_settings.localswitches) then
  1595. exit;
  1596. current_asmdata.getjumplabel(hl);
  1597. case ovloc.loc of
  1598. LOC_VOID:
  1599. begin
  1600. ai:=taicpu.op_sym(A_B,hl);
  1601. ai.is_jmp:=true;
  1602. if not((def.typ=pointerdef) or
  1603. ((def.typ=orddef) and
  1604. (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,bool8bit,bool16bit,bool32bit]))) then
  1605. ai.SetCondition(C_VC)
  1606. else
  1607. if TAiCpu(List.Last).opcode in [A_RSB,A_RSC,A_SBC,A_SUB] then
  1608. ai.SetCondition(C_CS)
  1609. else
  1610. ai.SetCondition(C_CC);
  1611. list.concat(ai);
  1612. end;
  1613. LOC_FLAGS:
  1614. begin
  1615. hflags:=ovloc.resflags;
  1616. inverse_flags(hflags);
  1617. cg.a_jmp_flags(list,hflags,hl);
  1618. end;
  1619. else
  1620. internalerror(200409281);
  1621. end;
  1622. a_call_name(list,'FPC_OVERFLOW');
  1623. a_label(list,hl);
  1624. end;
  1625. procedure tcgarm.g_save_standard_registers(list : TAsmList);
  1626. begin
  1627. { this work is done in g_proc_entry }
  1628. end;
  1629. procedure tcgarm.g_restore_standard_registers(list : TAsmList);
  1630. begin
  1631. { this work is done in g_proc_exit }
  1632. end;
  1633. procedure tcgarm.a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
  1634. var
  1635. ai : taicpu;
  1636. begin
  1637. ai:=Taicpu.Op_sym(A_B,l);
  1638. ai.SetCondition(OpCmp2AsmCond[cond]);
  1639. ai.is_jmp:=true;
  1640. list.concat(ai);
  1641. end;
  1642. procedure tcgarm.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
  1643. procedure loadvmttor12;
  1644. var
  1645. href : treference;
  1646. begin
  1647. reference_reset_base(href,NR_R0,0);
  1648. cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R12);
  1649. end;
  1650. procedure op_onr12methodaddr;
  1651. var
  1652. href : treference;
  1653. begin
  1654. if (procdef.extnumber=$ffff) then
  1655. Internalerror(200006139);
  1656. { call/jmp vmtoffs(%eax) ; method offs }
  1657. reference_reset_base(href,NR_R12,procdef._class.vmtmethodoffset(procdef.extnumber));
  1658. cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R12);
  1659. list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R12));
  1660. end;
  1661. var
  1662. make_global : boolean;
  1663. begin
  1664. if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
  1665. Internalerror(200006137);
  1666. if not assigned(procdef._class) or
  1667. (procdef.procoptions*[po_classmethod, po_staticmethod,
  1668. po_methodpointer, po_interrupt, po_iocheck]<>[]) then
  1669. Internalerror(200006138);
  1670. if procdef.owner.symtabletype<>ObjectSymtable then
  1671. Internalerror(200109191);
  1672. make_global:=false;
  1673. if (not current_module.is_unit) or
  1674. (cs_create_smart in current_settings.moduleswitches) or
  1675. (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
  1676. make_global:=true;
  1677. if make_global then
  1678. list.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
  1679. else
  1680. list.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
  1681. { set param1 interface to self }
  1682. g_adjust_self_value(list,procdef,ioffset);
  1683. { case 4 }
  1684. if po_virtualmethod in procdef.procoptions then
  1685. begin
  1686. loadvmttor12;
  1687. op_onr12methodaddr;
  1688. end
  1689. { case 0 }
  1690. else
  1691. list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(procdef.mangledname)));
  1692. list.concat(Tai_symbol_end.Createname(labelname));
  1693. end;
  1694. procedure tcg64farm.a_op64_reg_reg(list : TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64);
  1695. begin
  1696. case op of
  1697. OP_NEG:
  1698. begin
  1699. list.concat(setoppostfix(taicpu.op_reg_reg_const(A_RSB,regdst.reglo,regsrc.reglo,0),PF_S));
  1700. list.concat(taicpu.op_reg_reg_const(A_RSC,regdst.reghi,regsrc.reghi,0));
  1701. end;
  1702. OP_NOT:
  1703. begin
  1704. cg.a_op_reg_reg(list,OP_NOT,OS_INT,regsrc.reglo,regdst.reglo);
  1705. cg.a_op_reg_reg(list,OP_NOT,OS_INT,regsrc.reghi,regdst.reghi);
  1706. end;
  1707. else
  1708. a_op64_reg_reg_reg(list,op,size,regsrc,regdst,regdst);
  1709. end;
  1710. end;
  1711. procedure tcg64farm.a_op64_const_reg(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;reg : tregister64);
  1712. begin
  1713. a_op64_const_reg_reg(list,op,size,value,reg,reg);
  1714. end;
  1715. procedure tcg64farm.a_op64_const_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64);
  1716. var
  1717. ovloc : tlocation;
  1718. begin
  1719. a_op64_const_reg_reg_checkoverflow(list,op,size,value,regsrc,regdst,false,ovloc);
  1720. end;
  1721. procedure tcg64farm.a_op64_reg_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);
  1722. var
  1723. ovloc : tlocation;
  1724. begin
  1725. a_op64_reg_reg_reg_checkoverflow(list,op,size,regsrc1,regsrc2,regdst,false,ovloc);
  1726. end;
  1727. procedure tcg64farm.a_op64_const_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);
  1728. var
  1729. tmpreg : tregister;
  1730. b : byte;
  1731. begin
  1732. ovloc.loc:=LOC_VOID;
  1733. case op of
  1734. OP_NEG,
  1735. OP_NOT :
  1736. internalerror(200306017);
  1737. end;
  1738. if (setflags or tcgarm(cg).cgsetflags) and (op in [OP_ADD,OP_SUB]) then
  1739. begin
  1740. case op of
  1741. OP_ADD:
  1742. begin
  1743. if is_shifter_const(lo(value),b) then
  1744. list.concat(setoppostfix(taicpu.op_reg_reg_const(A_ADD,regdst.reglo,regsrc.reglo,lo(value)),PF_S))
  1745. else
  1746. begin
  1747. tmpreg:=cg.getintregister(list,OS_32);
  1748. cg.a_load_const_reg(list,OS_32,lo(value),tmpreg);
  1749. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
  1750. end;
  1751. if is_shifter_const(hi(value),b) then
  1752. list.concat(setoppostfix(taicpu.op_reg_reg_const(A_ADC,regdst.reghi,regsrc.reghi,hi(value)),PF_S))
  1753. else
  1754. begin
  1755. tmpreg:=cg.getintregister(list,OS_32);
  1756. cg.a_load_const_reg(list,OS_32,hi(value),tmpreg);
  1757. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc.reghi,tmpreg),PF_S));
  1758. end;
  1759. end;
  1760. OP_SUB:
  1761. begin
  1762. if is_shifter_const(lo(value),b) then
  1763. list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,regdst.reglo,regsrc.reglo,lo(value)),PF_S))
  1764. else
  1765. begin
  1766. tmpreg:=cg.getintregister(list,OS_32);
  1767. cg.a_load_const_reg(list,OS_32,lo(value),tmpreg);
  1768. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
  1769. end;
  1770. if is_shifter_const(hi(value),b) then
  1771. list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SBC,regdst.reghi,regsrc.reghi,hi(value)),PF_S))
  1772. else
  1773. begin
  1774. tmpreg:=cg.getintregister(list,OS_32);
  1775. cg.a_load_const_reg(list,OS_32,hi(value),tmpreg);
  1776. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc.reghi,tmpreg),PF_S));
  1777. end;
  1778. end;
  1779. else
  1780. internalerror(200502131);
  1781. end;
  1782. if size=OS_64 then
  1783. begin
  1784. { the arm has an weired opinion how flags for SUB/ADD are handled }
  1785. ovloc.loc:=LOC_FLAGS;
  1786. case op of
  1787. OP_ADD:
  1788. ovloc.resflags:=F_CS;
  1789. OP_SUB:
  1790. ovloc.resflags:=F_CC;
  1791. end;
  1792. end;
  1793. end
  1794. else
  1795. begin
  1796. case op of
  1797. OP_AND,OP_OR,OP_XOR:
  1798. begin
  1799. cg.a_op_const_reg_reg(list,op,OS_32,lo(value),regsrc.reglo,regdst.reglo);
  1800. cg.a_op_const_reg_reg(list,op,OS_32,hi(value),regsrc.reghi,regdst.reghi);
  1801. end;
  1802. OP_ADD:
  1803. begin
  1804. if is_shifter_const(lo(value),b) then
  1805. list.concat(setoppostfix(taicpu.op_reg_reg_const(A_ADD,regdst.reglo,regsrc.reglo,lo(value)),PF_S))
  1806. else
  1807. begin
  1808. tmpreg:=cg.getintregister(list,OS_32);
  1809. cg.a_load_const_reg(list,OS_32,lo(value),tmpreg);
  1810. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
  1811. end;
  1812. if is_shifter_const(hi(value),b) then
  1813. list.concat(taicpu.op_reg_reg_const(A_ADC,regdst.reghi,regsrc.reghi,hi(value)))
  1814. else
  1815. begin
  1816. tmpreg:=cg.getintregister(list,OS_32);
  1817. cg.a_load_const_reg(list,OS_32,hi(value),tmpreg);
  1818. list.concat(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc.reghi,tmpreg));
  1819. end;
  1820. end;
  1821. OP_SUB:
  1822. begin
  1823. if is_shifter_const(lo(value),b) then
  1824. list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,regdst.reglo,regsrc.reglo,lo(value)),PF_S))
  1825. else
  1826. begin
  1827. tmpreg:=cg.getintregister(list,OS_32);
  1828. cg.a_load_const_reg(list,OS_32,lo(value),tmpreg);
  1829. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
  1830. end;
  1831. if is_shifter_const(hi(value),b) then
  1832. list.concat(taicpu.op_reg_reg_const(A_SBC,regdst.reghi,regsrc.reghi,hi(value)))
  1833. else
  1834. begin
  1835. tmpreg:=cg.getintregister(list,OS_32);
  1836. cg.a_load_const_reg(list,OS_32,hi(value),tmpreg);
  1837. list.concat(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc.reghi,tmpreg));
  1838. end;
  1839. end;
  1840. else
  1841. internalerror(2003083101);
  1842. end;
  1843. end;
  1844. end;
  1845. procedure tcg64farm.a_op64_reg_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);
  1846. begin
  1847. ovloc.loc:=LOC_VOID;
  1848. case op of
  1849. OP_NEG,
  1850. OP_NOT :
  1851. internalerror(200306017);
  1852. end;
  1853. if (setflags or tcgarm(cg).cgsetflags) and (op in [OP_ADD,OP_SUB]) then
  1854. begin
  1855. case op of
  1856. OP_ADD:
  1857. begin
  1858. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc1.reglo,regsrc2.reglo),PF_S));
  1859. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc1.reghi,regsrc2.reghi),PF_S));
  1860. end;
  1861. OP_SUB:
  1862. begin
  1863. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc2.reglo,regsrc1.reglo),PF_S));
  1864. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc2.reghi,regsrc1.reghi),PF_S));
  1865. end;
  1866. else
  1867. internalerror(2003083101);
  1868. end;
  1869. if size=OS_64 then
  1870. begin
  1871. { the arm has an weired opinion how flags for SUB/ADD are handled }
  1872. ovloc.loc:=LOC_FLAGS;
  1873. case op of
  1874. OP_ADD:
  1875. ovloc.resflags:=F_CS;
  1876. OP_SUB:
  1877. ovloc.resflags:=F_CC;
  1878. end;
  1879. end;
  1880. end
  1881. else
  1882. begin
  1883. case op of
  1884. OP_AND,OP_OR,OP_XOR:
  1885. begin
  1886. cg.a_op_reg_reg_reg(list,op,OS_32,regsrc1.reglo,regsrc2.reglo,regdst.reglo);
  1887. cg.a_op_reg_reg_reg(list,op,OS_32,regsrc1.reghi,regsrc2.reghi,regdst.reghi);
  1888. end;
  1889. OP_ADD:
  1890. begin
  1891. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc1.reglo,regsrc2.reglo),PF_S));
  1892. list.concat(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc1.reghi,regsrc2.reghi));
  1893. end;
  1894. OP_SUB:
  1895. begin
  1896. list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc2.reglo,regsrc1.reglo),PF_S));
  1897. list.concat(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc2.reghi,regsrc1.reghi));
  1898. end;
  1899. else
  1900. internalerror(2003083101);
  1901. end;
  1902. end;
  1903. end;
  1904. begin
  1905. cg:=tcgarm.create;
  1906. cg64:=tcg64farm.create;
  1907. end.