ncgld.pas 42 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958
  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;
  23. type
  24. tcgloadnode = class(tloadnode)
  25. procedure pass_2;override;
  26. procedure generate_picvaraccess;virtual;
  27. end;
  28. tcgassignmentnode = class(tassignmentnode)
  29. procedure pass_2;override;
  30. end;
  31. tcgarrayconstructornode = class(tarrayconstructornode)
  32. procedure pass_2;override;
  33. end;
  34. tcgrttinode = class(trttinode)
  35. procedure pass_2;override;
  36. end;
  37. implementation
  38. uses
  39. cutils,
  40. systems,
  41. verbose,globtype,globals,
  42. symconst,symtype,symdef,symsym,defutil,paramgr,
  43. ncnv,ncon,nmem,nbas,
  44. aasmbase,aasmtai,aasmcpu,
  45. cgbase,pass_2,
  46. procinfo,
  47. cpubase,parabase,
  48. tgobj,ncgutil,
  49. cgutils,cgobj,
  50. ncgbas;
  51. {*****************************************************************************
  52. SecondLoad
  53. *****************************************************************************}
  54. procedure tcgloadnode.generate_picvaraccess;
  55. begin
  56. {$ifndef sparc}
  57. location.reference.base:=current_procinfo.got;
  58. location.reference.symbol:=objectlibrary.newasmsymbol(tglobalvarsym(symtableentry).mangledname+'@GOT',AB_EXTERNAL,AT_DATA);
  59. {$endif sparc}
  60. end;
  61. procedure tcgloadnode.pass_2;
  62. var
  63. hregister : tregister;
  64. symtabletype : tsymtabletype;
  65. href : treference;
  66. newsize : tcgsize;
  67. endrelocatelab,
  68. norelocatelab : tasmlabel;
  69. paraloc1 : tcgpara;
  70. begin
  71. { we don't know the size of all arrays }
  72. newsize:=def_cgsize(resulttype.def);
  73. location_reset(location,LOC_REFERENCE,newsize);
  74. case symtableentry.typ of
  75. absolutevarsym :
  76. begin
  77. { this is only for toasm and toaddr }
  78. case tabsolutevarsym(symtableentry).abstyp of
  79. toaddr :
  80. begin
  81. {$ifdef i386}
  82. if tabsolutevarsym(symtableentry).absseg then
  83. location.reference.segment:=NR_FS;
  84. {$endif i386}
  85. location.reference.offset:=tabsolutevarsym(symtableentry).addroffset;
  86. end;
  87. toasm :
  88. location.reference.symbol:=objectlibrary.newasmsymbol(tabsolutevarsym(symtableentry).mangledname,AB_EXTERNAL,AT_DATA);
  89. else
  90. internalerror(200310283);
  91. end;
  92. end;
  93. constsym:
  94. begin
  95. if tconstsym(symtableentry).consttyp=constresourcestring then
  96. begin
  97. location_reset(location,LOC_CREFERENCE,OS_ADDR);
  98. location.reference.symbol:=objectlibrary.newasmsymbol(make_mangledname('RESOURCESTRINGLIST',tconstsym(symtableentry).owner,''),AB_EXTERNAL,AT_DATA);
  99. location.reference.offset:=tconstsym(symtableentry).resstrindex*(4+sizeof(aint)*3)+4+sizeof(aint);
  100. end
  101. else
  102. internalerror(22798);
  103. end;
  104. globalvarsym,
  105. localvarsym,
  106. paravarsym :
  107. begin
  108. symtabletype:=symtable.symtabletype;
  109. hregister:=NR_NO;
  110. if (target_info.system=system_powerpc_darwin) and
  111. ([vo_is_dll_var,vo_is_external] * tabstractvarsym(symtableentry).varoptions <> []) then
  112. begin
  113. if not(pi_needs_got in current_procinfo.flags) then
  114. internalerror(200403022);
  115. generate_picvaraccess;
  116. end
  117. else if (vo_is_dll_var in tabstractvarsym(symtableentry).varoptions) then
  118. { DLL variable }
  119. begin
  120. hregister:=cg.getaddressregister(exprasmlist);
  121. location.reference.symbol:=objectlibrary.newasmsymbol(tglobalvarsym(symtableentry).mangledname,AB_EXTERNAL,AT_DATA);
  122. cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,location.reference,hregister);
  123. reference_reset_base(location.reference,hregister,0);
  124. end
  125. {$ifndef segment_threadvars}
  126. { Thread variable }
  127. else if (vo_is_thread_var in tabstractvarsym(symtableentry).varoptions) then
  128. begin
  129. {
  130. Thread var loading is optimized to first check if
  131. a relocate function is available. When the function
  132. is available it is called to retrieve the address.
  133. Otherwise the address is loaded with the symbol
  134. The code needs to be in the order to first handle the
  135. call and then the address load to be sure that the
  136. register that is used for returning is the same (PFV)
  137. }
  138. objectlibrary.getlabel(norelocatelab);
  139. objectlibrary.getlabel(endrelocatelab);
  140. { make sure hregister can't allocate the register necessary for the parameter }
  141. paraloc1.init;
  142. paramanager.getintparaloc(pocall_default,1,paraloc1);
  143. hregister:=cg.getaddressregister(exprasmlist);
  144. reference_reset_symbol(href,objectlibrary.newasmsymbol('FPC_THREADVAR_RELOCATE',AB_EXTERNAL,AT_DATA),0);
  145. cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,href,hregister);
  146. cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,hregister,norelocatelab);
  147. { don't save the allocated register else the result will be destroyed later }
  148. reference_reset_symbol(href,objectlibrary.newasmsymbol(tglobalvarsym(symtableentry).mangledname,AB_EXTERNAL,AT_DATA),0);
  149. paramanager.allocparaloc(exprasmlist,paraloc1);
  150. cg.a_param_ref(exprasmlist,OS_ADDR,href,paraloc1);
  151. paramanager.freeparaloc(exprasmlist,paraloc1);
  152. paraloc1.done;
  153. cg.allocallcpuregisters(exprasmlist);
  154. cg.a_call_reg(exprasmlist,hregister);
  155. cg.deallocallcpuregisters(exprasmlist);
  156. cg.getcpuregister(exprasmlist,NR_FUNCTION_RESULT_REG);
  157. cg.ungetcpuregister(exprasmlist,NR_FUNCTION_RESULT_REG);
  158. hregister:=cg.getaddressregister(exprasmlist);
  159. cg.a_load_reg_reg(exprasmlist,OS_INT,OS_ADDR,NR_FUNCTION_RESULT_REG,hregister);
  160. cg.a_jmp_always(exprasmlist,endrelocatelab);
  161. cg.a_label(exprasmlist,norelocatelab);
  162. { no relocation needed, load the address of the variable only, the
  163. layout of a threadvar is (4 bytes pointer):
  164. 0 - Threadvar index
  165. 4 - Threadvar value in single threading }
  166. reference_reset_symbol(href,objectlibrary.newasmsymbol(tglobalvarsym(symtableentry).mangledname,AB_EXTERNAL,AT_DATA),sizeof(aint));
  167. cg.a_loadaddr_ref_reg(exprasmlist,href,hregister);
  168. cg.a_label(exprasmlist,endrelocatelab);
  169. location.reference.base:=hregister;
  170. end
  171. {$endif}
  172. { Nested variable }
  173. else if assigned(left) then
  174. begin
  175. if not(symtabletype in [localsymtable,parasymtable]) then
  176. internalerror(200309285);
  177. secondpass(left);
  178. if left.location.loc<>LOC_REGISTER then
  179. internalerror(200309286);
  180. if tabstractnormalvarsym(symtableentry).localloc.loc<>LOC_REFERENCE then
  181. internalerror(200409241);
  182. hregister:=left.location.register;
  183. reference_reset_base(location.reference,hregister,tabstractnormalvarsym(symtableentry).localloc.reference.offset);
  184. end
  185. { Normal (or external) variable }
  186. else
  187. begin
  188. {$ifdef OLDREGVARS}
  189. { in case it is a register variable: }
  190. if tvarsym(symtableentry).localloc.loc in [LOC_REGISTER,LOC_FPUREGISTER] then
  191. begin
  192. case getregtype(tvarsym(symtableentry).localloc.register) of
  193. R_FPUREGISTER :
  194. begin
  195. location_reset(location,LOC_CFPUREGISTER,def_cgsize(resulttype.def));
  196. location.register:=tvarsym(symtableentry).localloc.register;
  197. end;
  198. R_INTREGISTER :
  199. begin
  200. location_reset(location,LOC_CREGISTER,def_cgsize(resulttype.def));
  201. location.register:=tvarsym(symtableentry).localloc.register;
  202. hregister := location.register;
  203. end;
  204. else
  205. internalerror(200301172);
  206. end;
  207. end
  208. else
  209. {$endif OLDREGVARS}
  210. begin
  211. case symtabletype of
  212. stt_exceptsymtable,
  213. localsymtable,
  214. parasymtable :
  215. location:=tabstractnormalvarsym(symtableentry).localloc;
  216. globalsymtable,
  217. staticsymtable :
  218. begin
  219. if (target_info.system=system_powerpc_darwin) and
  220. (cs_create_pic in aktmoduleswitches) then
  221. begin
  222. generate_picvaraccess;
  223. if not(pi_needs_got in current_procinfo.flags) then
  224. internalerror(200403023);
  225. end
  226. else
  227. begin
  228. if tabstractnormalvarsym(symtableentry).localloc.loc=LOC_INVALID then
  229. reference_reset_symbol(location.reference,objectlibrary.newasmsymbol(tglobalvarsym(symtableentry).mangledname,AB_EXTERNAL,AT_DATA),0)
  230. else
  231. location:=tglobalvarsym(symtableentry).localloc;
  232. {$ifdef segment_threadvars}
  233. if (vo_is_thread_var in tabstractvarsym(symtableentry).varoptions) then
  234. location.reference.segment:=NR_GS;
  235. {$endif}
  236. end;
  237. end;
  238. else
  239. internalerror(200305102);
  240. end;
  241. end;
  242. end;
  243. { handle call by reference variables when they are not
  244. alreayd copied to local copies. Also ignore the reference
  245. when we need to load the self pointer for objects }
  246. if is_addr_param_load then
  247. begin
  248. if (location.loc in [LOC_CREGISTER,LOC_REGISTER]) then
  249. hregister:=location.register
  250. else
  251. begin
  252. hregister:=cg.getaddressregister(exprasmlist);
  253. { we need to load only an address }
  254. location.size:=OS_ADDR;
  255. cg.a_load_loc_reg(exprasmlist,location.size,location,hregister);
  256. end;
  257. location_reset(location,LOC_REFERENCE,newsize);
  258. location.reference.base:=hregister;
  259. end;
  260. { make const a LOC_CREFERENCE }
  261. if (tabstractvarsym(symtableentry).varspez=vs_const) and
  262. (location.loc=LOC_REFERENCE) then
  263. location.loc:=LOC_CREFERENCE;
  264. end;
  265. procsym:
  266. begin
  267. if not assigned(procdef) then
  268. internalerror(200312011);
  269. if assigned(left) then
  270. begin
  271. {
  272. THIS IS A TERRIBLE HACK!!!!!! WHICH WILL NOT WORK
  273. ON 64-BIT SYSTEMS: SINCE PROCSYM FOR METHODS
  274. CONSISTS OF TWO OS_ADDR, so you cannot set it
  275. to OS_64 - how to solve?? Carl
  276. Solved. Florian
  277. }
  278. if (sizeof(aint) = 4) then
  279. location_reset(location,LOC_CREFERENCE,OS_64)
  280. else if (sizeof(aint) = 8) then
  281. location_reset(location,LOC_CREFERENCE,OS_128)
  282. else
  283. internalerror(20020520);
  284. tg.GetTemp(exprasmlist,2*sizeof(aint),tt_normal,location.reference);
  285. secondpass(left);
  286. { load class instance address }
  287. case left.location.loc of
  288. LOC_CREGISTER,
  289. LOC_REGISTER:
  290. begin
  291. { this is not possible for objects }
  292. if is_object(left.resulttype.def) then
  293. internalerror(200304234);
  294. hregister:=left.location.register;
  295. end;
  296. LOC_CREFERENCE,
  297. LOC_REFERENCE:
  298. begin
  299. hregister:=cg.getaddressregister(exprasmlist);
  300. if is_class_or_interface(left.resulttype.def) then
  301. cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.reference,hregister)
  302. else
  303. cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,hregister);
  304. location_freetemp(exprasmlist,left.location);
  305. end;
  306. else
  307. internalerror(26019);
  308. end;
  309. { store the class instance address }
  310. href:=location.reference;
  311. inc(href.offset,sizeof(aint));
  312. cg.a_load_reg_ref(exprasmlist,OS_ADDR,OS_ADDR,hregister,href);
  313. { virtual method ? }
  314. if (po_virtualmethod in procdef.procoptions) then
  315. begin
  316. { load vmt pointer }
  317. reference_reset_base(href,hregister,0);
  318. hregister:=cg.getaddressregister(exprasmlist);
  319. cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,href,hregister);
  320. { load method address }
  321. reference_reset_base(href,hregister,procdef._class.vmtmethodoffset(procdef.extnumber));
  322. hregister:=cg.getaddressregister(exprasmlist);
  323. cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,href,hregister);
  324. { ... and store it }
  325. cg.a_load_reg_ref(exprasmlist,OS_ADDR,OS_ADDR,hregister,location.reference);
  326. end
  327. else
  328. begin
  329. { load address of the function }
  330. reference_reset_symbol(href,objectlibrary.newasmsymbol(procdef.mangledname,AB_EXTERNAL,AT_FUNCTION),0);
  331. hregister:=cg.getaddressregister(exprasmlist);
  332. cg.a_loadaddr_ref_reg(exprasmlist,href,hregister);
  333. cg.a_load_reg_ref(exprasmlist,OS_ADDR,OS_ADDR,hregister,location.reference);
  334. end;
  335. end
  336. else
  337. begin
  338. {!!!!! Be aware, work on virtual methods too }
  339. location.reference.symbol:=objectlibrary.newasmsymbol(procdef.mangledname,AB_EXTERNAL,AT_FUNCTION);
  340. end;
  341. end;
  342. typedconstsym :
  343. begin
  344. location.reference.symbol:=objectlibrary.newasmsymbol(ttypedconstsym(symtableentry).mangledname,AB_EXTERNAL,AT_DATA);
  345. end;
  346. labelsym :
  347. begin
  348. location.reference.symbol:=objectlibrary.newasmsymbol(tlabelsym(symtableentry).mangledname,AB_EXTERNAL,AT_FUNCTION);
  349. end;
  350. else internalerror(4);
  351. end;
  352. end;
  353. {*****************************************************************************
  354. SecondAssignment
  355. *****************************************************************************}
  356. procedure tcgassignmentnode.pass_2;
  357. var
  358. otlabel,hlabel,oflabel : tasmlabel;
  359. fputyp : tfloattype;
  360. href : treference;
  361. releaseright : boolean;
  362. len : aint;
  363. r:Tregister;
  364. begin
  365. location_reset(location,LOC_VOID,OS_NO);
  366. otlabel:=truelabel;
  367. oflabel:=falselabel;
  368. objectlibrary.getlabel(truelabel);
  369. objectlibrary.getlabel(falselabel);
  370. {
  371. in most cases we can process first the right node which contains
  372. the most complex code. Exceptions for this are:
  373. - result is in flags, loading left will then destroy the flags
  374. - result is a jump, loading left must be already done before the jump is made
  375. - result need reference count, when left points to a value used in
  376. right then decreasing the refcnt on left can possibly release
  377. the memory before right increased the refcnt, result is that an
  378. empty value is assigned
  379. - calln, call destroys most registers and is therefor 'complex'
  380. But not when the result is in the flags, then
  381. loading the left node afterwards can destroy the flags.
  382. }
  383. if not(right.expectloc in [LOC_FLAGS,LOC_JUMP]) and
  384. ((right.nodetype=calln) or
  385. (right.resulttype.def.needs_inittable) or
  386. (right.registersint>=left.registersint)) then
  387. begin
  388. secondpass(right);
  389. { increment source reference counter, this is
  390. useless for string constants}
  391. if (right.resulttype.def.needs_inittable) and
  392. (right.nodetype<>stringconstn) then
  393. begin
  394. location_force_mem(exprasmlist,right.location);
  395. location_get_data_ref(exprasmlist,right.location,href,false);
  396. cg.g_incrrefcount(exprasmlist,right.resulttype.def,href);
  397. end;
  398. if codegenerror then
  399. exit;
  400. if not(nf_concat_string in flags) then
  401. begin
  402. { left can't be never a 64 bit LOC_REGISTER, so the 3. arg }
  403. { can be false }
  404. secondpass(left);
  405. { decrement destination reference counter }
  406. if (left.resulttype.def.needs_inittable) then
  407. begin
  408. location_get_data_ref(exprasmlist,left.location,href,false);
  409. cg.g_decrrefcount(exprasmlist,left.resulttype.def,href);
  410. end;
  411. if codegenerror then
  412. exit;
  413. end;
  414. end
  415. else
  416. begin
  417. { calculate left sides }
  418. { don't do it yet if it's a crgister (JM) }
  419. if not(nf_concat_string in flags) then
  420. begin
  421. secondpass(left);
  422. { decrement destination reference counter }
  423. if (left.resulttype.def.needs_inittable) then
  424. begin
  425. location_get_data_ref(exprasmlist,left.location,href,false);
  426. cg.g_decrrefcount(exprasmlist,left.resulttype.def,href);
  427. end;
  428. if codegenerror then
  429. exit;
  430. end;
  431. { left can't be never a 64 bit LOC_REGISTER, so the 3. arg }
  432. { can be false }
  433. secondpass(right);
  434. { increment source reference counter, this is
  435. useless for string constants}
  436. if (right.resulttype.def.needs_inittable) and
  437. (right.nodetype<>stringconstn) then
  438. begin
  439. location_force_mem(exprasmlist,right.location);
  440. location_get_data_ref(exprasmlist,right.location,href,false);
  441. cg.g_incrrefcount(exprasmlist,right.resulttype.def,href);
  442. end;
  443. if codegenerror then
  444. exit;
  445. end;
  446. releaseright:=true;
  447. { optimize temp to temp copies }
  448. (* if (left.nodetype = temprefn) and
  449. { we may store certain temps in registers in the future, then this }
  450. { optimization will have to be adapted }
  451. (left.location.loc = LOC_REFERENCE) and
  452. (right.location.loc = LOC_REFERENCE) and
  453. tg.istemp(right.location.reference) and
  454. (tg.sizeoftemp(exprasmlist,right.location.reference) = tg.sizeoftemp(exprasmlist,left.location.reference)) then
  455. begin
  456. { in theory, we should also make sure the left temp type is }
  457. { already more or less of the same kind (ie. we must not }
  458. { assign an ansistring to a normaltemp). In practice, the }
  459. { assignment node will have already taken care of this for us }
  460. tcgtemprefnode(left).changelocation(right.location.reference);
  461. end
  462. { shortstring assignments are handled separately }
  463. else *)
  464. if is_shortstring(left.resulttype.def) then
  465. begin
  466. {
  467. we can get here only in the following situations
  468. for the right node:
  469. - empty constant string
  470. - char
  471. }
  472. { empty constant string }
  473. if (right.nodetype=stringconstn) and
  474. (tstringconstnode(right).len=0) then
  475. begin
  476. cg.a_load_const_ref(exprasmlist,OS_8,0,left.location.reference);
  477. end
  478. { char loading }
  479. else if is_char(right.resulttype.def) then
  480. begin
  481. if right.nodetype=ordconstn then
  482. begin
  483. if (target_info.endian = endian_little) then
  484. cg.a_load_const_ref(exprasmlist,OS_16,(tordconstnode(right).value shl 8) or 1,
  485. left.location.reference)
  486. else
  487. cg.a_load_const_ref(exprasmlist,OS_16,tordconstnode(right).value or (1 shl 8),
  488. left.location.reference);
  489. end
  490. else
  491. begin
  492. href:=left.location.reference;
  493. cg.a_load_const_ref(exprasmlist,OS_8,1,href);
  494. inc(href.offset,1);
  495. case right.location.loc of
  496. LOC_REGISTER,
  497. LOC_CREGISTER :
  498. begin
  499. r:=cg.makeregsize(exprasmlist,right.location.register,OS_8);
  500. cg.a_load_reg_ref(exprasmlist,OS_8,OS_8,r,href);
  501. end;
  502. LOC_REFERENCE,
  503. LOC_CREFERENCE :
  504. cg.a_load_ref_ref(exprasmlist,OS_8,OS_8,right.location.reference,href);
  505. else
  506. internalerror(200205111);
  507. end;
  508. end;
  509. end
  510. else
  511. internalerror(200204249);
  512. end
  513. else
  514. begin
  515. case right.location.loc of
  516. LOC_CONSTANT :
  517. begin
  518. {$ifndef cpu64bit}
  519. if right.location.size in [OS_64,OS_S64] then
  520. cg64.a_load64_const_loc(exprasmlist,right.location.value64,left.location)
  521. else
  522. {$endif cpu64bit}
  523. cg.a_load_const_loc(exprasmlist,right.location.value,left.location);
  524. end;
  525. LOC_REFERENCE,
  526. LOC_CREFERENCE :
  527. begin
  528. case left.location.loc of
  529. LOC_REGISTER,
  530. LOC_CREGISTER :
  531. begin
  532. {$ifndef cpu64bit}
  533. if left.location.size in [OS_64,OS_S64] then
  534. cg64.a_load64_ref_reg(exprasmlist,right.location.reference,left.location.register64)
  535. else
  536. {$endif cpu64bit}
  537. cg.a_load_ref_reg(exprasmlist,right.location.size,left.location.size,right.location.reference,left.location.register);
  538. end;
  539. LOC_FPUREGISTER,
  540. LOC_CFPUREGISTER :
  541. begin
  542. cg.a_loadfpu_ref_reg(exprasmlist,
  543. right.location.size,
  544. right.location.reference,
  545. left.location.register);
  546. end;
  547. LOC_REFERENCE,
  548. LOC_CREFERENCE :
  549. begin
  550. {$warning HACK: unaligned test, maybe remove all unaligned locations (array of char) from the compiler}
  551. { Use unaligned copy when the offset is not aligned }
  552. len:=left.resulttype.def.size;
  553. if (right.location.reference.offset mod sizeof(aint)<>0) or
  554. (left.location.reference.offset mod sizeof(aint)<>0) or
  555. (right.resulttype.def.alignment<sizeof(aint)) then
  556. cg.g_concatcopy_unaligned(exprasmlist,right.location.reference,left.location.reference,len)
  557. else
  558. cg.g_concatcopy(exprasmlist,right.location.reference,left.location.reference,len);
  559. end;
  560. LOC_MMREGISTER,
  561. LOC_CMMREGISTER:
  562. cg.a_loadmm_ref_reg(exprasmlist,
  563. right.location.size,
  564. left.location.size,
  565. right.location.reference,
  566. left.location.register,mms_movescalar);
  567. else
  568. internalerror(200203284);
  569. end;
  570. end;
  571. {$ifdef SUPPORT_MMX}
  572. LOC_CMMXREGISTER,
  573. LOC_MMXREGISTER:
  574. begin
  575. if left.location.loc=LOC_CMMXREGISTER then
  576. cg.a_loadmm_reg_reg(exprasmlist,OS_M64,OS_M64,right.location.register,left.location.register,nil)
  577. else
  578. cg.a_loadmm_reg_ref(exprasmlist,OS_M64,OS_M64,right.location.register,left.location.reference,nil);
  579. end;
  580. {$endif SUPPORT_MMX}
  581. LOC_MMREGISTER,
  582. LOC_CMMREGISTER:
  583. begin
  584. if left.resulttype.def.deftype=arraydef then
  585. begin
  586. end
  587. else
  588. begin
  589. if left.location.loc=LOC_CMMREGISTER then
  590. cg.a_loadmm_reg_reg(exprasmlist,right.location.size,left.location.size,right.location.register,left.location.register,mms_movescalar)
  591. else
  592. cg.a_loadmm_reg_ref(exprasmlist,right.location.size,left.location.size,right.location.register,left.location.reference,mms_movescalar);
  593. end;
  594. end;
  595. LOC_REGISTER,
  596. LOC_CREGISTER :
  597. begin
  598. {$ifndef cpu64bit}
  599. if left.location.size in [OS_64,OS_S64] then
  600. cg64.a_load64_reg_loc(exprasmlist,
  601. right.location.register64,left.location)
  602. else
  603. {$endif cpu64bit}
  604. cg.a_load_reg_loc(exprasmlist,right.location.size,right.location.register,left.location);
  605. end;
  606. LOC_FPUREGISTER,
  607. LOC_CFPUREGISTER :
  608. begin
  609. if (left.resulttype.def.deftype=floatdef) then
  610. fputyp:=tfloatdef(left.resulttype.def).typ
  611. else
  612. if (right.resulttype.def.deftype=floatdef) then
  613. fputyp:=tfloatdef(right.resulttype.def).typ
  614. else
  615. if (right.nodetype=typeconvn) and
  616. (ttypeconvnode(right).left.resulttype.def.deftype=floatdef) then
  617. fputyp:=tfloatdef(ttypeconvnode(right).left.resulttype.def).typ
  618. else
  619. fputyp:=s32real;
  620. { we can't do direct moves between fpu and mm registers }
  621. if left.location.loc in [LOC_MMREGISTER,LOC_CMMREGISTER] then
  622. begin
  623. location_force_mmregscalar(exprasmlist,right.location,false);
  624. cg.a_loadmm_reg_reg(exprasmlist,
  625. tfloat2tcgsize[fputyp],tfloat2tcgsize[fputyp],
  626. right.location.register,left.location.register,mms_movescalar);
  627. end
  628. else
  629. cg.a_loadfpu_reg_loc(exprasmlist,
  630. tfloat2tcgsize[fputyp],
  631. right.location.register,left.location);
  632. end;
  633. LOC_JUMP :
  634. begin
  635. objectlibrary.getlabel(hlabel);
  636. cg.a_label(exprasmlist,truelabel);
  637. cg.a_load_const_loc(exprasmlist,1,left.location);
  638. cg.a_jmp_always(exprasmlist,hlabel);
  639. cg.a_label(exprasmlist,falselabel);
  640. cg.a_load_const_loc(exprasmlist,0,left.location);
  641. cg.a_label(exprasmlist,hlabel);
  642. end;
  643. {$ifdef cpuflags}
  644. LOC_FLAGS :
  645. begin
  646. {This can be a wordbool or longbool too, no?}
  647. if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
  648. cg.g_flags2reg(exprasmlist,def_cgsize(left.resulttype.def),right.location.resflags,left.location.register)
  649. else
  650. begin
  651. if not(left.location.loc = LOC_REFERENCE) then
  652. internalerror(200203273);
  653. cg.g_flags2ref(exprasmlist,def_cgsize(left.resulttype.def),right.location.resflags,left.location.reference);
  654. end;
  655. end;
  656. {$endif cpuflags}
  657. end;
  658. end;
  659. if releaseright then
  660. location_freetemp(exprasmlist,right.location);
  661. truelabel:=otlabel;
  662. falselabel:=oflabel;
  663. end;
  664. {*****************************************************************************
  665. SecondArrayConstruct
  666. *****************************************************************************}
  667. const
  668. vtInteger = 0;
  669. vtBoolean = 1;
  670. vtChar = 2;
  671. vtExtended = 3;
  672. vtString = 4;
  673. vtPointer = 5;
  674. vtPChar = 6;
  675. vtObject = 7;
  676. vtClass = 8;
  677. vtWideChar = 9;
  678. vtPWideChar = 10;
  679. vtAnsiString32 = 11;
  680. vtCurrency = 12;
  681. vtVariant = 13;
  682. vtInterface = 14;
  683. vtWideString = 15;
  684. vtInt64 = 16;
  685. vtQWord = 17;
  686. vtAnsiString16 = 18;
  687. vtAnsiString64 = 19;
  688. procedure tcgarrayconstructornode.pass_2;
  689. var
  690. hp : tarrayconstructornode;
  691. href : treference;
  692. lt : tdef;
  693. vaddr : boolean;
  694. vtype : longint;
  695. freetemp,
  696. dovariant : boolean;
  697. elesize : longint;
  698. tmpreg : tregister;
  699. paraloc : tcgparalocation;
  700. begin
  701. dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
  702. if dovariant then
  703. elesize:=sizeof(aint)+sizeof(aint)
  704. else
  705. elesize:=tarraydef(resulttype.def).elesize;
  706. location_reset(location,LOC_CREFERENCE,OS_NO);
  707. fillchar(paraloc,sizeof(paraloc),0);
  708. { Allocate always a temp, also if no elements are required, to
  709. be sure that location is valid (PFV) }
  710. if tarraydef(resulttype.def).highrange=-1 then
  711. tg.GetTemp(exprasmlist,elesize,tt_normal,location.reference)
  712. else
  713. tg.GetTemp(exprasmlist,(tarraydef(resulttype.def).highrange+1)*elesize,tt_normal,location.reference);
  714. href:=location.reference;
  715. { Process nodes in array constructor }
  716. hp:=self;
  717. while assigned(hp) do
  718. begin
  719. if assigned(hp.left) then
  720. begin
  721. freetemp:=true;
  722. secondpass(hp.left);
  723. if codegenerror then
  724. exit;
  725. { Move flags and jump in register }
  726. if hp.left.location.loc in [LOC_FLAGS,LOC_JUMP] then
  727. location_force_reg(exprasmlist,hp.left.location,def_cgsize(hp.left.resulttype.def),false);
  728. if dovariant then
  729. begin
  730. { find the correct vtype value }
  731. vtype:=$ff;
  732. vaddr:=false;
  733. lt:=hp.left.resulttype.def;
  734. case lt.deftype of
  735. enumdef,
  736. orddef :
  737. begin
  738. if is_64bit(lt) then
  739. begin
  740. case torddef(lt).typ of
  741. s64bit:
  742. vtype:=vtInt64;
  743. u64bit:
  744. vtype:=vtQWord;
  745. end;
  746. freetemp:=false;
  747. vaddr:=true;
  748. end
  749. else if (lt.deftype=enumdef) or
  750. is_integer(lt) then
  751. vtype:=vtInteger
  752. else
  753. if is_boolean(lt) then
  754. vtype:=vtBoolean
  755. else
  756. if (lt.deftype=orddef) then
  757. begin
  758. case torddef(lt).typ of
  759. uchar:
  760. vtype:=vtChar;
  761. uwidechar:
  762. vtype:=vtWideChar;
  763. end;
  764. end;
  765. end;
  766. floatdef :
  767. begin
  768. if is_currency(lt) then
  769. vtype:=vtCurrency
  770. else
  771. vtype:=vtExtended;
  772. freetemp:=false;
  773. vaddr:=true;
  774. end;
  775. procvardef,
  776. pointerdef :
  777. begin
  778. if is_pchar(lt) then
  779. vtype:=vtPChar
  780. else if is_pwidechar(lt) then
  781. vtype:=vtPWideChar
  782. else
  783. vtype:=vtPointer;
  784. end;
  785. variantdef :
  786. begin
  787. vtype:=vtVariant;
  788. vaddr:=true;
  789. freetemp:=false;
  790. end;
  791. classrefdef :
  792. vtype:=vtClass;
  793. objectdef :
  794. if is_interface(lt) then
  795. vtype:=vtInterface
  796. { vtObject really means a class based on TObject }
  797. else if is_class(lt) then
  798. vtype:=vtObject
  799. else
  800. internalerror(200505171);
  801. stringdef :
  802. begin
  803. if is_shortstring(lt) then
  804. begin
  805. vtype:=vtString;
  806. vaddr:=true;
  807. freetemp:=false;
  808. end
  809. else
  810. if is_ansistring(lt) then
  811. {$ifdef ansistring_bits}
  812. begin
  813. case Tstringdef(lt).string_typ of
  814. st_ansistring16:
  815. vtype:=vtAnsiString16;
  816. st_ansistring32:
  817. vtype:=vtAnsiString32;
  818. st_ansistring64:
  819. vtype:=vtAnsiString64;
  820. end;
  821. freetemp:=false;
  822. end
  823. {$else}
  824. begin
  825. vtype:=vtAnsiString;
  826. freetemp:=false;
  827. end
  828. {$endif}
  829. else
  830. if is_widestring(lt) then
  831. begin
  832. vtype:=vtWideString;
  833. freetemp:=false;
  834. end;
  835. end;
  836. end;
  837. if vtype=$ff then
  838. internalerror(14357);
  839. { write changing field update href to the next element }
  840. inc(href.offset,sizeof(aint));
  841. if vaddr then
  842. begin
  843. location_force_mem(exprasmlist,hp.left.location);
  844. tmpreg:=cg.getaddressregister(exprasmlist);
  845. cg.a_loadaddr_ref_reg(exprasmlist,hp.left.location.reference,tmpreg);
  846. cg.a_load_reg_ref(exprasmlist,OS_ADDR,OS_ADDR,tmpreg,href);
  847. end
  848. else
  849. cg.a_load_loc_ref(exprasmlist,OS_ADDR,hp.left.location,href);
  850. { update href to the vtype field and write it }
  851. dec(href.offset,sizeof(aint));
  852. cg.a_load_const_ref(exprasmlist, OS_INT,vtype,href);
  853. { goto next array element }
  854. inc(href.offset,sizeof(aint)*2);
  855. end
  856. else
  857. { normal array constructor of the same type }
  858. begin
  859. if (is_ansistring(left.resulttype.def) or
  860. is_widestring(left.resulttype.def) or
  861. (left.resulttype.def.deftype=variantdef)) then
  862. freetemp:=false;
  863. case hp.left.location.loc of
  864. LOC_FPUREGISTER,
  865. LOC_CFPUREGISTER :
  866. cg.a_loadfpu_reg_ref(exprasmlist,hp.left.location.size,hp.left.location.register,href);
  867. LOC_REFERENCE,
  868. LOC_CREFERENCE :
  869. begin
  870. if is_shortstring(hp.left.resulttype.def) then
  871. cg.g_copyshortstring(exprasmlist,hp.left.location.reference,href,
  872. Tstringdef(hp.left.resulttype.def).len)
  873. else
  874. cg.g_concatcopy(exprasmlist,hp.left.location.reference,href,elesize);
  875. end;
  876. else
  877. begin
  878. {$ifndef cpu64bit}
  879. if hp.left.location.size in [OS_64,OS_S64] then
  880. cg64.a_load64_loc_ref(exprasmlist,hp.left.location,href)
  881. else
  882. {$endif cpu64bit}
  883. cg.a_load_loc_ref(exprasmlist,hp.left.location.size,hp.left.location,href);
  884. end;
  885. end;
  886. inc(href.offset,elesize);
  887. end;
  888. if freetemp then
  889. location_freetemp(exprasmlist,hp.left.location);
  890. end;
  891. { load next entry }
  892. hp:=tarrayconstructornode(hp.right);
  893. end;
  894. end;
  895. {*****************************************************************************
  896. SecondRTTI
  897. *****************************************************************************}
  898. procedure tcgrttinode.pass_2;
  899. begin
  900. location_reset(location,LOC_CREFERENCE,OS_NO);
  901. location.reference.symbol:=rttidef.get_rtti_label(rttitype);
  902. end;
  903. begin
  904. cloadnode:=tcgloadnode;
  905. cassignmentnode:=tcgassignmentnode;
  906. carrayconstructornode:=tcgarrayconstructornode;
  907. crttinode:=tcgrttinode;
  908. end.