ncgld.pas 41 KB

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