ncgld.pas 57 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. Generate assembler for nodes that handle loads and assignments which
  4. are the same for all (most) processors
  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 ncgld;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. node,nld,cgutils;
  23. type
  24. tcgloadnode = class(tloadnode)
  25. procedure pass_generate_code;override;
  26. procedure generate_picvaraccess;virtual;
  27. procedure changereflocation(const ref: treference);
  28. end;
  29. tcgassignmentnode = class(tassignmentnode)
  30. procedure pass_generate_code;override;
  31. end;
  32. tcgarrayconstructornode = class(tarrayconstructornode)
  33. procedure pass_generate_code;override;
  34. end;
  35. tcgrttinode = class(trttinode)
  36. procedure pass_generate_code;override;
  37. end;
  38. implementation
  39. uses
  40. cutils,
  41. systems,
  42. verbose,globtype,globals,constexp,
  43. nutils,
  44. symtable,symconst,symtype,symdef,symsym,defutil,paramgr,
  45. ncnv,ncon,nmem,nbas,ncgrtti,
  46. aasmbase,aasmtai,aasmdata,aasmcpu,
  47. cgbase,pass_2,
  48. procinfo,
  49. cpubase,parabase,
  50. tgobj,ncgutil,
  51. cgobj,
  52. ncgbas,ncgflw,
  53. wpobase;
  54. {*****************************************************************************
  55. SSA (for memory temps) support
  56. *****************************************************************************}
  57. type
  58. preplacerefrec = ^treplacerefrec;
  59. treplacerefrec = record
  60. old, new: preference;
  61. ressym: tsym;
  62. end;
  63. function doreplaceref(var n: tnode; para: pointer): foreachnoderesult;
  64. var
  65. rr: preplacerefrec absolute para;
  66. begin
  67. result := fen_false;
  68. case n.nodetype of
  69. loadn:
  70. begin
  71. { regular variable }
  72. if (tabstractvarsym(tloadnode(n).symtableentry).varoptions * [vo_is_dll_var, vo_is_thread_var] = []) and
  73. not assigned(tloadnode(n).left) and
  74. { not function result, or no exit in function }
  75. (((tloadnode(n).symtableentry <> rr^.ressym) and
  76. not(vo_is_funcret in tabstractvarsym(tloadnode(n).symtableentry).varoptions)) or
  77. not(fc_exit in flowcontrol)) and
  78. { stored in memory... }
  79. (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.loc in [LOC_REFERENCE]) and
  80. { ... at the place we are looking for }
  81. references_equal(tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.reference,rr^.old^) then
  82. begin
  83. { relocate variable }
  84. tcgloadnode(n).changereflocation(rr^.new^);
  85. result := fen_norecurse_true;
  86. end;
  87. end;
  88. temprefn:
  89. begin
  90. if (ti_valid in ttemprefnode(n).tempinfo^.flags) and
  91. { memory temp... }
  92. (ttemprefnode(n).tempinfo^.location.loc in [LOC_REFERENCE]) and
  93. { ... at the place we are looking for }
  94. references_equal(ttemprefnode(n).tempinfo^.location.reference,rr^.old^) then
  95. begin
  96. { relocate the temp }
  97. tcgtemprefnode(n).changelocation(rr^.new^);
  98. result := fen_norecurse_true;
  99. end;
  100. end;
  101. { Subscriptn must be rejected, otherwise we may replace an
  102. an entire record with a temp for its first field, mantis #13948)
  103. Exception: the field's size is the same as the entire record
  104. }
  105. subscriptn:
  106. if not(tsubscriptnode(n).left.resultdef.typ in [recorddef,objectdef]) or
  107. (tsubscriptnode(n).left.resultdef.size <> tsubscriptnode(n).resultdef.size) then
  108. result := fen_norecurse_false;
  109. { optimize the searching a bit }
  110. derefn,addrn,
  111. calln,inlinen,casen,
  112. addn,subn,muln,
  113. andn,orn,xorn,
  114. ltn,lten,gtn,gten,equaln,unequaln,
  115. slashn,divn,shrn,shln,notn,
  116. inn,
  117. asn,isn:
  118. result := fen_norecurse_false;
  119. end;
  120. end;
  121. function maybechangetemp(list: TAsmList; var n: tnode; const newref: treference): boolean;
  122. var
  123. rr: treplacerefrec;
  124. begin
  125. result := false;
  126. { only do for -O2 or higher (breaks debugging since }
  127. { variables move to different memory locations) }
  128. if not(cs_opt_level2 in current_settings.optimizerswitches) or
  129. { must be a copy to a memory location ... }
  130. (n.location.loc <> LOC_REFERENCE) or
  131. { not inside a control flow statement and no goto's in sight }
  132. ([fc_inflowcontrol,fc_gotolabel] * flowcontrol <> []) or
  133. { not for refcounted types, because those locations are }
  134. { still used later on in initialisation/finalisation code }
  135. (not(is_class(n.resultdef)) and
  136. n.resultdef.needs_inittable) or
  137. { source and destination are temps (= not global variables) }
  138. not tg.istemp(n.location.reference) or
  139. not tg.istemp(newref) or
  140. { and both point to the start of a temp, and the source is a }
  141. { non-persistent temp (otherwise we need some kind of copy- }
  142. { on-write support in case later on both are still used) }
  143. (tg.gettypeoftemp(newref) <> tt_normal) or
  144. not (tg.gettypeoftemp(n.location.reference) in [tt_normal,tt_persistent]) or
  145. { and both have the same size }
  146. (tg.sizeoftemp(current_asmdata.CurrAsmList,newref) <> tg.sizeoftemp(current_asmdata.CurrAsmList,n.location.reference)) then
  147. exit;
  148. { find the source of the old reference (loadnode or tempnode) }
  149. { and replace it with the new reference }
  150. rr.old := @n.location.reference;
  151. rr.new := @newref;
  152. rr.ressym := nil;
  153. if (current_procinfo.procdef.funcretloc[calleeside].loc<>LOC_VOID) and
  154. assigned(current_procinfo.procdef.funcretsym) and
  155. (tabstractvarsym(current_procinfo.procdef.funcretsym).refs <> 0) then
  156. if (current_procinfo.procdef.proctypeoption=potype_constructor) then
  157. rr.ressym:=tsym(current_procinfo.procdef.parast.Find('self'))
  158. else
  159. rr.ressym:=current_procinfo.procdef.funcretsym;
  160. { if source not found, don't do anything }
  161. if not foreachnodestatic(n,@doreplaceref,@rr) then
  162. exit;
  163. n.location.reference := newref;
  164. result:=true;
  165. end;
  166. {*****************************************************************************
  167. SecondLoad
  168. *****************************************************************************}
  169. procedure tcgloadnode.generate_picvaraccess;
  170. begin
  171. {$ifndef sparc}
  172. location.reference.base:=current_procinfo.got;
  173. location.reference.symbol:=current_asmdata.RefAsmSymbol(tstaticvarsym(symtableentry).mangledname+'@GOT');
  174. {$endif sparc}
  175. end;
  176. procedure tcgloadnode.changereflocation(const ref: treference);
  177. var
  178. oldtemptype: ttemptype;
  179. begin
  180. if (location.loc<>LOC_REFERENCE) then
  181. internalerror(2007020812);
  182. if not tg.istemp(location.reference) then
  183. internalerror(2007020813);
  184. oldtemptype:=tg.gettypeoftemp(location.reference);
  185. if (oldtemptype = tt_persistent) then
  186. tg.ChangeTempType(current_asmdata.CurrAsmList,location.reference,tt_normal);
  187. tg.ungettemp(current_asmdata.CurrAsmList,location.reference);
  188. location.reference:=ref;
  189. tg.ChangeTempType(current_asmdata.CurrAsmList,location.reference,oldtemptype);
  190. tabstractnormalvarsym(symtableentry).localloc:=location;
  191. end;
  192. procedure tcgloadnode.pass_generate_code;
  193. var
  194. hregister : tregister;
  195. vs : tabstractnormalvarsym;
  196. gvs : tstaticvarsym;
  197. pd : tprocdef;
  198. href : treference;
  199. newsize : tcgsize;
  200. endrelocatelab,
  201. norelocatelab : tasmlabel;
  202. paraloc1 : tcgpara;
  203. begin
  204. { we don't know the size of all arrays }
  205. newsize:=def_cgsize(resultdef);
  206. { alignment is overridden per case below }
  207. location_reset_ref(location,LOC_REFERENCE,newsize,resultdef.alignment);
  208. case symtableentry.typ of
  209. absolutevarsym :
  210. begin
  211. { this is only for toasm and toaddr }
  212. case tabsolutevarsym(symtableentry).abstyp of
  213. toaddr :
  214. begin
  215. {$ifdef i386}
  216. if tabsolutevarsym(symtableentry).absseg then
  217. location.reference.segment:=NR_FS;
  218. {$endif i386}
  219. location.reference.offset:=aint(tabsolutevarsym(symtableentry).addroffset);
  220. end;
  221. toasm :
  222. location.reference.symbol:=current_asmdata.RefAsmSymbol(tabsolutevarsym(symtableentry).mangledname);
  223. else
  224. internalerror(200310283);
  225. end;
  226. end;
  227. constsym:
  228. begin
  229. if tconstsym(symtableentry).consttyp=constresourcestring then
  230. begin
  231. location_reset_ref(location,LOC_CREFERENCE,OS_ADDR,sizeof(pint));
  232. location.reference.symbol:=current_asmdata.RefAsmSymbol(make_mangledname('RESSTR',symtableentry.owner,symtableentry.name));
  233. { Resourcestring layout:
  234. TResourceStringRecord = Packed Record
  235. Name,
  236. CurrentValue,
  237. DefaultValue : AnsiString;
  238. HashValue : LongWord;
  239. end;
  240. }
  241. location.reference.offset:=sizeof(pint);
  242. end
  243. else
  244. internalerror(22798);
  245. end;
  246. staticvarsym :
  247. begin
  248. gvs:=tstaticvarsym(symtableentry);
  249. if ([vo_is_dll_var,vo_is_external] * gvs.varoptions <> []) then
  250. begin
  251. { assume external variables use the default alignment }
  252. location.reference.alignment:=gvs.vardef.alignment;
  253. location.reference.base := cg.g_indirect_sym_load(current_asmdata.CurrAsmList,tstaticvarsym(symtableentry).mangledname,
  254. vo_is_weak_external in gvs.varoptions);
  255. if (location.reference.base <> NR_NO) then
  256. exit;
  257. end
  258. else
  259. begin
  260. location.reference.alignment:=var_align(gvs.vardef.alignment);
  261. end;
  262. if (vo_is_dll_var in gvs.varoptions) then
  263. { DLL variable }
  264. begin
  265. hregister:=cg.getaddressregister(current_asmdata.CurrAsmList);
  266. if not(vo_is_weak_external in gvs.varoptions) then
  267. location.reference.symbol:=current_asmdata.RefAsmSymbol(tstaticvarsym(symtableentry).mangledname)
  268. else
  269. location.reference.symbol:=current_asmdata.WeakRefAsmSymbol(tstaticvarsym(symtableentry).mangledname);
  270. cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,location.reference,hregister);
  271. reference_reset_base(location.reference,hregister,0,location.reference.alignment);
  272. end
  273. { Thread variable }
  274. else if (vo_is_thread_var in gvs.varoptions) and
  275. not(tf_section_threadvars in target_info.flags) then
  276. begin
  277. if (tf_section_threadvars in target_info.flags) then
  278. begin
  279. if gvs.localloc.loc=LOC_INVALID then
  280. if not(vo_is_weak_external in gvs.varoptions) then
  281. reference_reset_symbol(location.reference,current_asmdata.RefAsmSymbol(gvs.mangledname),0,location.reference.alignment)
  282. else
  283. reference_reset_symbol(location.reference,current_asmdata.WeakRefAsmSymbol(gvs.mangledname),0,location.reference.alignment)
  284. else
  285. location:=gvs.localloc;
  286. {$ifdef i386}
  287. case target_info.system of
  288. system_i386_linux:
  289. location.reference.segment:=NR_GS;
  290. system_i386_win32:
  291. location.reference.segment:=NR_FS;
  292. end;
  293. {$endif i386}
  294. end
  295. else
  296. begin
  297. {
  298. Thread var loading is optimized to first check if
  299. a relocate function is available. When the function
  300. is available it is called to retrieve the address.
  301. Otherwise the address is loaded with the symbol
  302. The code needs to be in the order to first handle the
  303. call and then the address load to be sure that the
  304. register that is used for returning is the same (PFV)
  305. }
  306. current_asmdata.getjumplabel(norelocatelab);
  307. current_asmdata.getjumplabel(endrelocatelab);
  308. { make sure hregister can't allocate the register necessary for the parameter }
  309. paraloc1.init;
  310. paramanager.getintparaloc(pocall_default,1,paraloc1);
  311. hregister:=cg.getaddressregister(current_asmdata.CurrAsmList);
  312. reference_reset_symbol(href,current_asmdata.RefAsmSymbol('FPC_THREADVAR_RELOCATE'),0,sizeof(pint));
  313. cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,hregister);
  314. cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_ADDR,OC_EQ,0,hregister,norelocatelab);
  315. { don't save the allocated register else the result will be destroyed later }
  316. if not(vo_is_weak_external in gvs.varoptions) then
  317. reference_reset_symbol(href,current_asmdata.RefAsmSymbol(gvs.mangledname),0,sizeof(pint))
  318. else
  319. reference_reset_symbol(href,current_asmdata.WeakRefAsmSymbol(gvs.mangledname),0,sizeof(pint));
  320. paramanager.allocparaloc(current_asmdata.CurrAsmList,paraloc1);
  321. cg.a_param_ref(current_asmdata.CurrAsmList,OS_32,href,paraloc1);
  322. paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
  323. paraloc1.done;
  324. cg.allocallcpuregisters(current_asmdata.CurrAsmList);
  325. cg.a_call_reg(current_asmdata.CurrAsmList,hregister);
  326. cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
  327. cg.getcpuregister(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
  328. cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
  329. hregister:=cg.getaddressregister(current_asmdata.CurrAsmList);
  330. cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_ADDR,NR_FUNCTION_RESULT_REG,hregister);
  331. cg.a_jmp_always(current_asmdata.CurrAsmList,endrelocatelab);
  332. cg.a_label(current_asmdata.CurrAsmList,norelocatelab);
  333. { no relocation needed, load the address of the variable only, the
  334. layout of a threadvar is (4 bytes pointer):
  335. 0 - Threadvar index
  336. 4 - Threadvar value in single threading }
  337. if not(vo_is_weak_external in gvs.varoptions) then
  338. reference_reset_symbol(href,current_asmdata.RefAsmSymbol(gvs.mangledname),sizeof(pint),sizeof(pint))
  339. else
  340. reference_reset_symbol(href,current_asmdata.WeakRefAsmSymbol(gvs.mangledname),sizeof(pint),sizeof(pint));
  341. cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,href,hregister);
  342. cg.a_label(current_asmdata.CurrAsmList,endrelocatelab);
  343. location.reference.base:=hregister;
  344. end;
  345. end
  346. { Normal (or external) variable }
  347. else
  348. begin
  349. if gvs.localloc.loc=LOC_INVALID then
  350. if not(vo_is_weak_external in gvs.varoptions) then
  351. reference_reset_symbol(location.reference,current_asmdata.RefAsmSymbol(gvs.mangledname),0,location.reference.alignment)
  352. else
  353. reference_reset_symbol(location.reference,current_asmdata.WeakRefAsmSymbol(gvs.mangledname),0,location.reference.alignment)
  354. else
  355. location:=gvs.localloc;
  356. end;
  357. { make const a LOC_CREFERENCE }
  358. if (gvs.varspez=vs_const) and
  359. (location.loc=LOC_REFERENCE) then
  360. location.loc:=LOC_CREFERENCE;
  361. end;
  362. paravarsym,
  363. localvarsym :
  364. begin
  365. vs:=tabstractnormalvarsym(symtableentry);
  366. { Nested variable }
  367. if assigned(left) then
  368. begin
  369. secondpass(left);
  370. if left.location.loc<>LOC_REGISTER then
  371. internalerror(200309286);
  372. if vs.localloc.loc<>LOC_REFERENCE then
  373. internalerror(200409241);
  374. reference_reset_base(location.reference,left.location.register,vs.localloc.reference.offset,vs.localloc.reference.alignment);
  375. end
  376. else
  377. location:=vs.localloc;
  378. { handle call by reference variables when they are not
  379. already copied to local copies. Also ignore the reference
  380. when we need to load the self pointer for objects }
  381. if is_addr_param_load then
  382. begin
  383. if (location.loc in [LOC_CREGISTER,LOC_REGISTER]) then
  384. hregister:=location.register
  385. else
  386. begin
  387. hregister:=cg.getaddressregister(current_asmdata.CurrAsmList);
  388. { we need to load only an address }
  389. location.size:=OS_ADDR;
  390. cg.a_load_loc_reg(current_asmdata.CurrAsmList,location.size,location,hregister);
  391. end;
  392. { assume packed records may always be unaligned }
  393. if not(resultdef.typ in [recorddef,objectdef]) or
  394. (tabstractrecordsymtable(tabstractrecorddef(resultdef).symtable).usefieldalignment<>1) then
  395. location_reset_ref(location,LOC_REFERENCE,newsize,resultdef.alignment)
  396. else
  397. location_reset_ref(location,LOC_REFERENCE,newsize,1);
  398. location.reference.base:=hregister;
  399. end;
  400. { make const a LOC_CREFERENCE }
  401. if (vs.varspez=vs_const) and
  402. (location.loc=LOC_REFERENCE) then
  403. location.loc:=LOC_CREFERENCE;
  404. end;
  405. procsym:
  406. begin
  407. if not assigned(procdef) then
  408. internalerror(200312011);
  409. if assigned(left) then
  410. begin
  411. {$if sizeof(pint) = 4}
  412. location_reset_ref(location,LOC_CREFERENCE,OS_64,sizeof(pint));
  413. {$else} {$if sizeof(pint) = 8}
  414. location_reset_ref(location,LOC_CREFERENCE,OS_128,sizeof(pint));
  415. {$else}
  416. internalerror(20020520);
  417. {$endif} {$endif}
  418. tg.GetTemp(current_asmdata.CurrAsmList,2*sizeof(pint),sizeof(pint),tt_normal,location.reference);
  419. secondpass(left);
  420. { load class instance/classrefdef address }
  421. if left.location.loc=LOC_CONSTANT then
  422. location_force_reg(current_asmdata.CurrAsmList,left.location,OS_ADDR,false);
  423. case left.location.loc of
  424. LOC_CREGISTER,
  425. LOC_REGISTER:
  426. begin
  427. { this is not possible for objects }
  428. if is_object(left.resultdef) then
  429. internalerror(200304234);
  430. hregister:=left.location.register;
  431. end;
  432. LOC_CREFERENCE,
  433. LOC_REFERENCE:
  434. begin
  435. hregister:=cg.getaddressregister(current_asmdata.CurrAsmList);
  436. if not is_object(left.resultdef) then
  437. cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.reference,hregister)
  438. else
  439. cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,hregister);
  440. location_freetemp(current_asmdata.CurrAsmList,left.location);
  441. end;
  442. else
  443. internalerror(200610311);
  444. end;
  445. { store the class instance or classredef address }
  446. href:=location.reference;
  447. inc(href.offset,sizeof(pint));
  448. cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,hregister,href);
  449. { virtual method ? }
  450. if (po_virtualmethod in procdef.procoptions) and
  451. not(nf_inherited in flags) then
  452. begin
  453. if (not assigned(current_procinfo) or
  454. wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname)) then
  455. procdef._class.register_vmt_call(procdef.extnumber);
  456. {$ifdef vtentry}
  457. if not is_interface(procdef._class) then
  458. begin
  459. inc(current_asmdata.NextVTEntryNr);
  460. current_asmdata.CurrAsmList.Concat(tai_symbol.CreateName('VTREF'+tostr(current_asmdata.NextVTEntryNr)+'_'+procdef._class.vmt_mangledname+'$$'+tostr(vmtoffset div sizeof(pint)),AT_FUNCTION,0));
  461. end;
  462. {$endif vtentry}
  463. { a classrefdef already points to the VMT }
  464. if (left.resultdef.typ<>classrefdef) then
  465. begin
  466. { load vmt pointer }
  467. reference_reset_base(href,hregister,0,sizeof(pint));
  468. hregister:=cg.getaddressregister(current_asmdata.CurrAsmList);
  469. cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,hregister);
  470. end;
  471. { load method address }
  472. reference_reset_base(href,hregister,procdef._class.vmtmethodoffset(procdef.extnumber),sizeof(pint));
  473. hregister:=cg.getaddressregister(current_asmdata.CurrAsmList);
  474. cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,hregister);
  475. { ... and store it }
  476. cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,hregister,location.reference);
  477. end
  478. else
  479. begin
  480. { load address of the function }
  481. reference_reset_symbol(href,current_asmdata.RefAsmSymbol(procdef.mangledname),0,sizeof(pint));
  482. hregister:=cg.getaddressregister(current_asmdata.CurrAsmList);
  483. cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,href,hregister);
  484. cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,hregister,location.reference);
  485. end;
  486. end
  487. else
  488. begin
  489. pd:=tprocdef(tprocsym(symtableentry).ProcdefList[0]);
  490. if (po_external in pd.procoptions) then
  491. location.reference.base :=
  492. cg.g_indirect_sym_load(current_asmdata.CurrAsmList,pd.mangledname,
  493. po_weakexternal in pd.procoptions);
  494. {!!!!! Be aware, work on virtual methods too }
  495. if (location.reference.base = NR_NO) then
  496. if not(po_weakexternal in pd.procoptions) then
  497. location.reference.symbol:=current_asmdata.RefAsmSymbol(procdef.mangledname)
  498. else
  499. location.reference.symbol:=current_asmdata.WeakRefAsmSymbol(procdef.mangledname);
  500. end;
  501. end;
  502. labelsym :
  503. if assigned(tlabelsym(symtableentry).asmblocklabel) then
  504. location.reference.symbol:=tlabelsym(symtableentry).asmblocklabel
  505. else
  506. location.reference.symbol:=tcglabelnode((tlabelsym(symtableentry).code)).getasmlabel;
  507. else internalerror(200510032);
  508. end;
  509. end;
  510. {*****************************************************************************
  511. SecondAssignment
  512. *****************************************************************************}
  513. procedure tcgassignmentnode.pass_generate_code;
  514. var
  515. otlabel,hlabel,oflabel : tasmlabel;
  516. href : treference;
  517. releaseright : boolean;
  518. len : aint;
  519. r : tregister;
  520. oldflowcontrol : tflowcontrol;
  521. begin
  522. location_reset(location,LOC_VOID,OS_NO);
  523. otlabel:=current_procinfo.CurrTrueLabel;
  524. oflabel:=current_procinfo.CurrFalseLabel;
  525. current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
  526. current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
  527. {
  528. in most cases we can process first the right node which contains
  529. the most complex code. Exceptions for this are:
  530. - result is in flags, loading left will then destroy the flags
  531. - result is a jump, loading left must be already done before the jump is made
  532. - result need reference count, when left points to a value used in
  533. right then decreasing the refcnt on left can possibly release
  534. the memory before right increased the refcnt, result is that an
  535. empty value is assigned
  536. But not when the result is in the flags, then
  537. loading the left node afterwards can destroy the flags.
  538. }
  539. if not(right.expectloc in [LOC_FLAGS,LOC_JUMP]) and
  540. ((right.resultdef.needs_inittable) or
  541. (node_complexity(right)>node_complexity(left))) then
  542. begin
  543. secondpass(right);
  544. { increment source reference counter, this is
  545. useless for constants }
  546. if (right.resultdef.needs_inittable) and
  547. not is_constnode(right) then
  548. begin
  549. location_force_mem(current_asmdata.CurrAsmList,right.location);
  550. location_get_data_ref(current_asmdata.CurrAsmList,right.location,href,false,sizeof(pint));
  551. cg.g_incrrefcount(current_asmdata.CurrAsmList,right.resultdef,href);
  552. end;
  553. if codegenerror then
  554. exit;
  555. { left can't be never a 64 bit LOC_REGISTER, so the 3. arg }
  556. { can be false }
  557. secondpass(left);
  558. { decrement destination reference counter }
  559. if (left.resultdef.needs_inittable) then
  560. begin
  561. location_get_data_ref(current_asmdata.CurrAsmList,left.location,href,false,sizeof(pint));
  562. cg.g_decrrefcount(current_asmdata.CurrAsmList,left.resultdef,href);
  563. end;
  564. if codegenerror then
  565. exit;
  566. end
  567. else
  568. begin
  569. { calculate left sides }
  570. secondpass(left);
  571. { decrement destination reference counter }
  572. if (left.resultdef.needs_inittable) then
  573. begin
  574. location_get_data_ref(current_asmdata.CurrAsmList,left.location,href,false,sizeof(pint));
  575. cg.g_decrrefcount(current_asmdata.CurrAsmList,left.resultdef,href);
  576. end;
  577. if codegenerror then
  578. exit;
  579. { tell the SSA/SSL code that the left side was handled first so
  580. ni SSL is done
  581. }
  582. oldflowcontrol:=flowcontrol;
  583. include(flowcontrol,fc_lefthandled);
  584. { left can't be never a 64 bit LOC_REGISTER, so the 3. arg }
  585. { can be false }
  586. secondpass(right);
  587. flowcontrol:=oldflowcontrol;
  588. { increment source reference counter, this is
  589. useless for string constants}
  590. if (right.resultdef.needs_inittable) and
  591. (right.nodetype<>stringconstn) then
  592. begin
  593. location_force_mem(current_asmdata.CurrAsmList,right.location);
  594. location_get_data_ref(current_asmdata.CurrAsmList,right.location,href,false,sizeof(pint));
  595. cg.g_incrrefcount(current_asmdata.CurrAsmList,right.resultdef,href);
  596. end;
  597. if codegenerror then
  598. exit;
  599. end;
  600. releaseright:=true;
  601. { shortstring assignments are handled separately }
  602. if is_shortstring(left.resultdef) then
  603. begin
  604. {
  605. we can get here only in the following situations
  606. for the right node:
  607. - empty constant string
  608. - char
  609. }
  610. { The addn is replaced by a blockn or calln that already returns
  611. a shortstring }
  612. if is_shortstring(right.resultdef) and
  613. (right.nodetype in [blockn,calln]) then
  614. begin
  615. { nothing to do }
  616. end
  617. { empty constant string }
  618. else if (right.nodetype=stringconstn) and
  619. (tstringconstnode(right).len=0) then
  620. begin
  621. cg.a_load_const_ref(current_asmdata.CurrAsmList,OS_8,0,left.location.reference);
  622. end
  623. { char loading }
  624. else if is_char(right.resultdef) then
  625. begin
  626. if right.nodetype=ordconstn then
  627. begin
  628. if (target_info.endian = endian_little) then
  629. cg.a_load_const_ref(current_asmdata.CurrAsmList,OS_16,(tordconstnode(right).value.svalue shl 8) or 1,
  630. setalignment(left.location.reference,1))
  631. else
  632. cg.a_load_const_ref(current_asmdata.CurrAsmList,OS_16,tordconstnode(right).value.svalue or (1 shl 8),
  633. setalignment(left.location.reference,1));
  634. end
  635. else
  636. begin
  637. href:=left.location.reference;
  638. cg.a_load_const_ref(current_asmdata.CurrAsmList,OS_8,1,href);
  639. inc(href.offset,1);
  640. case right.location.loc of
  641. LOC_REGISTER,
  642. LOC_CREGISTER :
  643. begin
  644. r:=cg.makeregsize(current_asmdata.CurrAsmList,right.location.register,OS_8);
  645. cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_8,OS_8,r,href);
  646. end;
  647. LOC_REFERENCE,
  648. LOC_CREFERENCE :
  649. cg.a_load_ref_ref(current_asmdata.CurrAsmList,OS_8,OS_8,right.location.reference,href);
  650. else
  651. internalerror(200205111);
  652. end;
  653. end;
  654. end
  655. else
  656. internalerror(2002042410);
  657. end
  658. { try to reuse memory locations instead of copying }
  659. { copy to a memory location ... }
  660. else if (right.location.loc = LOC_REFERENCE) and
  661. maybechangetemp(current_asmdata.CurrAsmList,left,right.location.reference) then
  662. begin
  663. { if it worked, we're done }
  664. end
  665. else
  666. begin
  667. { SSA support }
  668. maybechangeloadnodereg(current_asmdata.CurrAsmList,left,false);
  669. maybechangeloadnodereg(current_asmdata.CurrAsmList,right,true);
  670. case right.location.loc of
  671. LOC_CONSTANT :
  672. begin
  673. {$ifndef cpu64bitalu}
  674. if (left.location.size in [OS_64,OS_S64]) or (right.location.size in [OS_64,OS_S64]) then
  675. cg64.a_load64_const_loc(current_asmdata.CurrAsmList,right.location.value64,left.location)
  676. else
  677. {$endif not cpu64bitalu}
  678. cg.a_load_const_loc(current_asmdata.CurrAsmList,right.location.value,left.location);
  679. end;
  680. LOC_REFERENCE,
  681. LOC_CREFERENCE :
  682. begin
  683. case left.location.loc of
  684. LOC_REGISTER,
  685. LOC_CREGISTER :
  686. begin
  687. {$ifndef cpu64bitalu}
  688. if left.location.size in [OS_64,OS_S64] then
  689. cg64.a_load64_ref_reg(current_asmdata.CurrAsmList,right.location.reference,left.location.register64)
  690. else
  691. {$endif not cpu64bitalu}
  692. cg.a_load_ref_reg(current_asmdata.CurrAsmList,right.location.size,left.location.size,right.location.reference,left.location.register);
  693. end;
  694. LOC_FPUREGISTER,
  695. LOC_CFPUREGISTER :
  696. begin
  697. cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,
  698. right.location.size,left.location.size,
  699. right.location.reference,
  700. left.location.register);
  701. end;
  702. LOC_REFERENCE,
  703. LOC_CREFERENCE :
  704. begin
  705. if (left.resultdef.typ=floatdef) and
  706. (right.resultdef.typ=floatdef) and
  707. (left.location.size<>right.location.size) then
  708. begin
  709. cg.a_loadfpu_ref_ref(current_asmdata.CurrAsmList,
  710. right.location.size,left.location.size,
  711. right.location.reference,left.location.reference)
  712. end
  713. else
  714. begin
  715. { TODO: HACK: unaligned test, maybe remove all unaligned locations (array of char) from the compiler}
  716. { Use unaligned copy when the offset is not aligned }
  717. len:=left.resultdef.size;
  718. if (right.location.reference.offset mod sizeof(aint)<>0) or
  719. (left.location.reference.offset mod sizeof(aint)<>0) or
  720. (right.resultdef.alignment<sizeof(aint)) or
  721. ((right.location.reference.alignment<>0) and
  722. (right.location.reference.alignment<sizeof(aint))) or
  723. ((left.location.reference.alignment<>0) and
  724. (left.location.reference.alignment<sizeof(aint))) then
  725. cg.g_concatcopy_unaligned(current_asmdata.CurrAsmList,right.location.reference,left.location.reference,len)
  726. else
  727. cg.g_concatcopy(current_asmdata.CurrAsmList,right.location.reference,left.location.reference,len);
  728. end;
  729. end;
  730. LOC_MMREGISTER,
  731. LOC_CMMREGISTER:
  732. begin
  733. {$ifdef x86}
  734. if not use_sse(right.resultdef) then
  735. begin
  736. { perform size conversion if needed (the mm-code cannot }
  737. { convert an extended into a double/single, since sse }
  738. { doesn't support extended) }
  739. r:=cg.getfpuregister(current_asmdata.CurrAsmList,right.location.size);
  740. tg.gettemp(current_asmdata.CurrAsmList,left.resultdef.size,left.resultdef.alignment,tt_normal,href);
  741. cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,right.location.size,right.location.size,right.location.reference,r);
  742. cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,right.location.size,left.location.size,r,href);
  743. if releaseright then
  744. location_freetemp(current_asmdata.CurrAsmList,right.location);
  745. releaseright:=true;
  746. location_reset_ref(right.location,LOC_REFERENCE,left.location.size,0);
  747. right.location.reference:=href;
  748. end;
  749. {$endif}
  750. cg.a_loadmm_ref_reg(current_asmdata.CurrAsmList,
  751. right.location.size,
  752. left.location.size,
  753. right.location.reference,
  754. left.location.register,mms_movescalar);
  755. end;
  756. LOC_SUBSETREG,
  757. LOC_CSUBSETREG:
  758. cg.a_load_ref_subsetreg(current_asmdata.CurrAsmList,right.location.size,left.location.size,right.location.reference,left.location.sreg);
  759. LOC_SUBSETREF,
  760. LOC_CSUBSETREF:
  761. {$ifndef cpu64bitalu}
  762. if right.location.size in [OS_64,OS_S64] then
  763. cg64.a_load64_ref_subsetref(current_asmdata.CurrAsmList,right.location.reference,left.location.sref)
  764. else
  765. {$endif not cpu64bitalu}
  766. cg.a_load_ref_subsetref(current_asmdata.CurrAsmList,right.location.size,left.location.size,right.location.reference,left.location.sref);
  767. else
  768. internalerror(200203284);
  769. end;
  770. end;
  771. {$ifdef SUPPORT_MMX}
  772. LOC_CMMXREGISTER,
  773. LOC_MMXREGISTER:
  774. begin
  775. if left.location.loc=LOC_CMMXREGISTER then
  776. cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,OS_M64,OS_M64,right.location.register,left.location.register,nil)
  777. else
  778. cg.a_loadmm_reg_ref(current_asmdata.CurrAsmList,OS_M64,OS_M64,right.location.register,left.location.reference,nil);
  779. end;
  780. {$endif SUPPORT_MMX}
  781. LOC_MMREGISTER,
  782. LOC_CMMREGISTER:
  783. begin
  784. if left.resultdef.typ=arraydef then
  785. begin
  786. end
  787. else
  788. begin
  789. if left.location.loc=LOC_CMMREGISTER then
  790. cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,right.location.size,left.location.size,right.location.register,left.location.register,mms_movescalar)
  791. else
  792. cg.a_loadmm_reg_ref(current_asmdata.CurrAsmList,right.location.size,left.location.size,right.location.register,left.location.reference,mms_movescalar);
  793. end;
  794. end;
  795. LOC_REGISTER,
  796. LOC_CREGISTER :
  797. begin
  798. {$ifndef cpu64bitalu}
  799. if left.location.size in [OS_64,OS_S64] then
  800. cg64.a_load64_reg_loc(current_asmdata.CurrAsmList,
  801. right.location.register64,left.location)
  802. else
  803. {$endif not cpu64bitalu}
  804. cg.a_load_reg_loc(current_asmdata.CurrAsmList,right.location.size,right.location.register,left.location);
  805. end;
  806. LOC_FPUREGISTER,
  807. LOC_CFPUREGISTER :
  808. begin
  809. { we can't do direct moves between fpu and mm registers }
  810. if left.location.loc in [LOC_MMREGISTER,LOC_CMMREGISTER] then
  811. begin
  812. {$ifdef x86}
  813. if not use_sse(right.resultdef) then
  814. begin
  815. { perform size conversion if needed (the mm-code cannot convert an }
  816. { extended into a double/single, since sse doesn't support extended) }
  817. tg.gettemp(current_asmdata.CurrAsmList,left.resultdef.size,left.resultdef.alignment,tt_normal,href);
  818. cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,right.location.size,left.location.size,right.location.register,href);
  819. location_reset_ref(right.location,LOC_REFERENCE,left.location.size,0);
  820. right.location.reference:=href;
  821. end;
  822. {$endif}
  823. location_force_mmregscalar(current_asmdata.CurrAsmList,right.location,false);
  824. cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,
  825. right.location.size,left.location.size,
  826. right.location.register,left.location.register,mms_movescalar);
  827. end
  828. else
  829. cg.a_loadfpu_reg_loc(current_asmdata.CurrAsmList,
  830. right.location.size,
  831. right.location.register,left.location);
  832. end;
  833. LOC_SUBSETREG,
  834. LOC_CSUBSETREG:
  835. begin
  836. cg.a_load_subsetreg_loc(current_asmdata.CurrAsmList,
  837. right.location.size,right.location.sreg,left.location);
  838. end;
  839. LOC_SUBSETREF,
  840. LOC_CSUBSETREF:
  841. begin
  842. {$ifndef cpu64bitalu}
  843. if right.location.size in [OS_64,OS_S64] then
  844. cg64.a_load64_subsetref_loc(current_asmdata.CurrAsmList,right.location.sref,left.location)
  845. else
  846. {$endif not cpu64bitalu}
  847. cg.a_load_subsetref_loc(current_asmdata.CurrAsmList,
  848. right.location.size,right.location.sref,left.location);
  849. end;
  850. LOC_JUMP :
  851. begin
  852. current_asmdata.getjumplabel(hlabel);
  853. cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
  854. if is_pasbool(left.resultdef) then
  855. cg.a_load_const_loc(current_asmdata.CurrAsmList,1,left.location)
  856. else
  857. cg.a_load_const_loc(current_asmdata.CurrAsmList,-1,left.location);
  858. cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel);
  859. cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
  860. cg.a_load_const_loc(current_asmdata.CurrAsmList,0,left.location);
  861. cg.a_label(current_asmdata.CurrAsmList,hlabel);
  862. end;
  863. {$ifdef cpuflags}
  864. LOC_FLAGS :
  865. begin
  866. if is_pasbool(left.resultdef) then
  867. begin
  868. case left.location.loc of
  869. LOC_REGISTER,LOC_CREGISTER:
  870. cg.g_flags2reg(current_asmdata.CurrAsmList,left.location.size,right.location.resflags,left.location.register);
  871. LOC_REFERENCE:
  872. cg.g_flags2ref(current_asmdata.CurrAsmList,left.location.size,right.location.resflags,left.location.reference);
  873. LOC_SUBSETREG,LOC_SUBSETREF:
  874. begin
  875. r:=cg.getintregister(current_asmdata.CurrAsmList,left.location.size);
  876. cg.g_flags2reg(current_asmdata.CurrAsmList,left.location.size,right.location.resflags,r);
  877. cg.a_load_reg_loc(current_asmdata.CurrAsmList,left.location.size,r,left.location);
  878. end;
  879. else
  880. internalerror(200203273);
  881. end;
  882. end
  883. else
  884. begin
  885. r:=cg.getintregister(current_asmdata.CurrAsmList,left.location.size);
  886. cg.g_flags2reg(current_asmdata.CurrAsmList,left.location.size,right.location.resflags,r);
  887. cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,left.location.size,r,r);
  888. cg.a_load_reg_loc(current_asmdata.CurrAsmList,left.location.size,r,left.location);
  889. end;
  890. end;
  891. {$endif cpuflags}
  892. end;
  893. end;
  894. if releaseright then
  895. location_freetemp(current_asmdata.CurrAsmList,right.location);
  896. current_procinfo.CurrTrueLabel:=otlabel;
  897. current_procinfo.CurrFalseLabel:=oflabel;
  898. end;
  899. {*****************************************************************************
  900. SecondArrayConstruct
  901. *****************************************************************************}
  902. const
  903. vtInteger = 0;
  904. vtBoolean = 1;
  905. vtChar = 2;
  906. vtExtended = 3;
  907. vtString = 4;
  908. vtPointer = 5;
  909. vtPChar = 6;
  910. vtObject = 7;
  911. vtClass = 8;
  912. vtWideChar = 9;
  913. vtPWideChar = 10;
  914. vtAnsiString32 = 11;
  915. vtCurrency = 12;
  916. vtVariant = 13;
  917. vtInterface = 14;
  918. vtWideString = 15;
  919. vtInt64 = 16;
  920. vtQWord = 17;
  921. vtAnsiString16 = 18;
  922. vtAnsiString64 = 19;
  923. procedure tcgarrayconstructornode.pass_generate_code;
  924. var
  925. hp : tarrayconstructornode;
  926. href : treference;
  927. lt : tdef;
  928. paraloc : tcgparalocation;
  929. otlabel,
  930. oflabel : tasmlabel;
  931. vtype : longint;
  932. elesize,
  933. elealign : longint;
  934. tmpreg : tregister;
  935. vaddr : boolean;
  936. freetemp,
  937. dovariant : boolean;
  938. begin
  939. if is_packed_array(resultdef) then
  940. internalerror(200608042);
  941. dovariant:=(nf_forcevaria in flags) or is_variant_array(resultdef);
  942. if dovariant then
  943. begin
  944. elesize:=sizeof(pint)+sizeof(pint);
  945. elealign:=sizeof(pint);
  946. end
  947. else
  948. begin
  949. elesize:=tarraydef(resultdef).elesize;
  950. elealign:=tarraydef(resultdef).elementdef.alignment;
  951. end;
  952. { alignment is filled in by tg.gettemp below }
  953. location_reset_ref(location,LOC_CREFERENCE,OS_NO,0);
  954. fillchar(paraloc,sizeof(paraloc),0);
  955. { Allocate always a temp, also if no elements are required, to
  956. be sure that location is valid (PFV) }
  957. if tarraydef(resultdef).highrange=-1 then
  958. tg.GetTemp(current_asmdata.CurrAsmList,elesize,elealign,tt_normal,location.reference)
  959. else
  960. tg.GetTemp(current_asmdata.CurrAsmList,(tarraydef(resultdef).highrange+1)*elesize,resultdef.alignment,tt_normal,location.reference);
  961. href:=location.reference;
  962. { Process nodes in array constructor }
  963. hp:=self;
  964. while assigned(hp) do
  965. begin
  966. if assigned(hp.left) then
  967. begin
  968. freetemp:=true;
  969. if (hp.left.expectloc=LOC_JUMP) then
  970. begin
  971. otlabel:=current_procinfo.CurrTrueLabel;
  972. oflabel:=current_procinfo.CurrFalseLabel;
  973. current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
  974. current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
  975. end;
  976. secondpass(hp.left);
  977. { Move flags and jump in register }
  978. if hp.left.location.loc in [LOC_FLAGS,LOC_JUMP] then
  979. location_force_reg(current_asmdata.CurrAsmList,hp.left.location,def_cgsize(hp.left.resultdef),false);
  980. if (hp.left.location.loc=LOC_JUMP) then
  981. begin
  982. if (hp.left.expectloc<>LOC_JUMP) then
  983. internalerror(2007103101);
  984. current_procinfo.CurrTrueLabel:=otlabel;
  985. current_procinfo.CurrFalseLabel:=oflabel;
  986. end;
  987. if dovariant then
  988. begin
  989. { find the correct vtype value }
  990. vtype:=$ff;
  991. vaddr:=false;
  992. lt:=hp.left.resultdef;
  993. case lt.typ of
  994. enumdef,
  995. orddef :
  996. begin
  997. if is_64bit(lt) then
  998. begin
  999. case torddef(lt).ordtype of
  1000. scurrency:
  1001. vtype:=vtCurrency;
  1002. s64bit:
  1003. vtype:=vtInt64;
  1004. u64bit:
  1005. vtype:=vtQWord;
  1006. end;
  1007. freetemp:=false;
  1008. vaddr:=true;
  1009. end
  1010. else if (lt.typ=enumdef) or
  1011. is_integer(lt) then
  1012. vtype:=vtInteger
  1013. else
  1014. if is_boolean(lt) then
  1015. vtype:=vtBoolean
  1016. else
  1017. if (lt.typ=orddef) then
  1018. begin
  1019. case torddef(lt).ordtype of
  1020. uchar:
  1021. vtype:=vtChar;
  1022. uwidechar:
  1023. vtype:=vtWideChar;
  1024. end;
  1025. end;
  1026. end;
  1027. floatdef :
  1028. begin
  1029. if is_currency(lt) then
  1030. vtype:=vtCurrency
  1031. else
  1032. vtype:=vtExtended;
  1033. freetemp:=false;
  1034. vaddr:=true;
  1035. end;
  1036. procvardef,
  1037. pointerdef :
  1038. begin
  1039. if is_pchar(lt) then
  1040. vtype:=vtPChar
  1041. else if is_pwidechar(lt) then
  1042. vtype:=vtPWideChar
  1043. else
  1044. vtype:=vtPointer;
  1045. end;
  1046. variantdef :
  1047. begin
  1048. vtype:=vtVariant;
  1049. vaddr:=true;
  1050. freetemp:=false;
  1051. end;
  1052. classrefdef :
  1053. vtype:=vtClass;
  1054. objectdef :
  1055. if is_interface(lt) then
  1056. vtype:=vtInterface
  1057. { vtObject really means a class based on TObject }
  1058. else if is_class(lt) then
  1059. vtype:=vtObject
  1060. else
  1061. internalerror(200505171);
  1062. stringdef :
  1063. begin
  1064. if is_shortstring(lt) then
  1065. begin
  1066. vtype:=vtString;
  1067. vaddr:=true;
  1068. freetemp:=false;
  1069. end
  1070. else
  1071. if is_ansistring(lt) then
  1072. begin
  1073. vtype:=vtAnsiString;
  1074. freetemp:=false;
  1075. end
  1076. else
  1077. if is_widestring(lt) or is_unicodestring(lt) then
  1078. begin
  1079. vtype:=vtWideString;
  1080. freetemp:=false;
  1081. end;
  1082. end;
  1083. end;
  1084. if vtype=$ff then
  1085. internalerror(14357);
  1086. { write changing field update href to the next element }
  1087. inc(href.offset,sizeof(pint));
  1088. if vaddr then
  1089. begin
  1090. location_force_mem(current_asmdata.CurrAsmList,hp.left.location);
  1091. tmpreg:=cg.getaddressregister(current_asmdata.CurrAsmList);
  1092. cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,hp.left.location.reference,tmpreg);
  1093. cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,tmpreg,href);
  1094. end
  1095. else
  1096. cg.a_load_loc_ref(current_asmdata.CurrAsmList,OS_ADDR,hp.left.location,href);
  1097. { update href to the vtype field and write it }
  1098. dec(href.offset,sizeof(pint));
  1099. cg.a_load_const_ref(current_asmdata.CurrAsmList, OS_INT,vtype,href);
  1100. { goto next array element }
  1101. inc(href.offset,sizeof(pint)*2);
  1102. end
  1103. else
  1104. { normal array constructor of the same type }
  1105. begin
  1106. if resultdef.needs_inittable then
  1107. freetemp:=false;
  1108. case hp.left.location.loc of
  1109. LOC_MMREGISTER,
  1110. LOC_CMMREGISTER:
  1111. cg.a_loadmm_reg_ref(current_asmdata.CurrAsmList,hp.left.location.size,hp.left.location.size,
  1112. hp.left.location.register,href,mms_movescalar);
  1113. LOC_FPUREGISTER,
  1114. LOC_CFPUREGISTER :
  1115. cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,hp.left.location.size,hp.left.location.size,hp.left.location.register,href);
  1116. LOC_REFERENCE,
  1117. LOC_CREFERENCE :
  1118. begin
  1119. if is_shortstring(hp.left.resultdef) then
  1120. cg.g_copyshortstring(current_asmdata.CurrAsmList,hp.left.location.reference,href,
  1121. Tstringdef(hp.left.resultdef).len)
  1122. else
  1123. cg.g_concatcopy(current_asmdata.CurrAsmList,hp.left.location.reference,href,elesize);
  1124. end;
  1125. else
  1126. begin
  1127. {$ifndef cpu64bitalu}
  1128. if hp.left.location.size in [OS_64,OS_S64] then
  1129. cg64.a_load64_loc_ref(current_asmdata.CurrAsmList,hp.left.location,href)
  1130. else
  1131. {$endif not cpu64bitalu}
  1132. cg.a_load_loc_ref(current_asmdata.CurrAsmList,hp.left.location.size,hp.left.location,href);
  1133. end;
  1134. end;
  1135. inc(href.offset,elesize);
  1136. end;
  1137. if freetemp then
  1138. location_freetemp(current_asmdata.CurrAsmList,hp.left.location);
  1139. end;
  1140. { load next entry }
  1141. hp:=tarrayconstructornode(hp.right);
  1142. end;
  1143. end;
  1144. {*****************************************************************************
  1145. SecondRTTI
  1146. *****************************************************************************}
  1147. procedure tcgrttinode.pass_generate_code;
  1148. begin
  1149. location_reset_ref(location,LOC_CREFERENCE,OS_NO,sizeof(pint));
  1150. case rttidatatype of
  1151. rdt_normal:
  1152. location.reference.symbol:=RTTIWriter.get_rtti_label(rttidef,rttitype);
  1153. rdt_ord2str:
  1154. location.reference.symbol:=RTTIWriter.get_rtti_label_ord2str(rttidef,rttitype);
  1155. rdt_str2ord:
  1156. location.reference.symbol:=RTTIWriter.get_rtti_label_str2ord(rttidef,rttitype);
  1157. end;
  1158. end;
  1159. begin
  1160. cloadnode:=tcgloadnode;
  1161. cassignmentnode:=tcgassignmentnode;
  1162. carrayconstructornode:=tcgarrayconstructornode;
  1163. crttinode:=tcgrttinode;
  1164. end.