ncgmem.pas 47 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. Generate assembler for memory related nodes which are
  5. the same for all (most?) processors
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2 of the License, or
  9. (at your option) any later version.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. GNU General Public License for more details.
  14. You should have received a copy of the GNU General Public License
  15. along with this program; if not, write to the Free Software
  16. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17. ****************************************************************************
  18. }
  19. { This unit generate assembler for memory related nodes.
  20. }
  21. unit ncgmem;
  22. {$i fpcdefs.inc}
  23. interface
  24. uses
  25. cpuinfo,cpubase,
  26. node,nmem;
  27. type
  28. tcgloadvmtaddrnode = class(tloadvmtaddrnode)
  29. procedure pass_2;override;
  30. end;
  31. tcgaddrnode = class(taddrnode)
  32. procedure pass_2;override;
  33. end;
  34. tcgdoubleaddrnode = class(tdoubleaddrnode)
  35. procedure pass_2;override;
  36. end;
  37. tcgderefnode = class(tderefnode)
  38. procedure pass_2;override;
  39. end;
  40. tcgsubscriptnode = class(tsubscriptnode)
  41. procedure pass_2;override;
  42. end;
  43. tcgwithnode = class(twithnode)
  44. procedure pass_2;override;
  45. end;
  46. tcgvecnode = class(tvecnode)
  47. private
  48. procedure rangecheck_array;
  49. protected
  50. function get_mul_size : longint;
  51. {# This routine is used to calculate the address of the reference.
  52. On entry reg contains the index in the array,
  53. and l contains the size of each element in the array.
  54. This routine should update location.reference correctly,
  55. so it points to the correct address.
  56. }
  57. procedure update_reference_reg_mul(reg:tregister;l:aword);virtual;
  58. procedure second_wideansistring;virtual;
  59. procedure second_dynamicarray;virtual;
  60. public
  61. procedure pass_2;override;
  62. end;
  63. implementation
  64. uses
  65. {$ifdef delphi}
  66. sysutils,
  67. {$else}
  68. strings,
  69. {$endif}
  70. {$ifdef GDB}
  71. gdb,
  72. {$endif GDB}
  73. globtype,systems,
  74. cutils,verbose,globals,
  75. symconst,symdef,symsym,symtable,defutil,paramgr,
  76. aasmbase,aasmtai,
  77. cginfo,cgbase,pass_2,
  78. pass_1,nld,ncon,nadd,
  79. cgobj,tgobj,rgobj,ncgutil,symbase
  80. ;
  81. {*****************************************************************************
  82. TCGLOADNODE
  83. *****************************************************************************}
  84. procedure tcgloadvmtaddrnode.pass_2;
  85. var
  86. href : treference;
  87. begin
  88. location_reset(location,LOC_REGISTER,OS_ADDR);
  89. if (left.nodetype<>typen) then
  90. begin
  91. { left contains self, load vmt from self }
  92. secondpass(left);
  93. if is_object(left.resulttype.def) then
  94. begin
  95. case left.location.loc of
  96. LOC_CREFERENCE,
  97. LOC_REFERENCE:
  98. begin
  99. location_release(exprasmlist,left.location);
  100. reference_reset_base(href,rg.getaddressregister(exprasmlist),tobjectdef(left.resulttype.def).vmt_offset);
  101. cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,href.base);
  102. end;
  103. else
  104. internalerror(200305056);
  105. end;
  106. end
  107. else
  108. begin
  109. case left.location.loc of
  110. LOC_REGISTER:
  111. begin
  112. if not rg.isaddressregister(left.location.register) then
  113. begin
  114. location_release(exprasmlist,left.location);
  115. reference_reset_base(href,rg.getaddressregister(exprasmlist),tobjectdef(left.resulttype.def).vmt_offset);
  116. cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.register,href.base);
  117. end
  118. else
  119. reference_reset_base(href,left.location.register,tobjectdef(left.resulttype.def).vmt_offset);
  120. end;
  121. LOC_CREGISTER,
  122. LOC_CREFERENCE,
  123. LOC_REFERENCE:
  124. begin
  125. location_release(exprasmlist,left.location);
  126. reference_reset_base(href,rg.getaddressregister(exprasmlist),tobjectdef(left.resulttype.def).vmt_offset);
  127. cg.a_load_loc_reg(exprasmlist,OS_ADDR,left.location,href.base);
  128. end;
  129. else
  130. internalerror(200305057);
  131. end;
  132. end;
  133. reference_release(exprasmlist,href);
  134. location.register:=rg.getaddressregister(exprasmlist);
  135. cg.g_maybe_testself(exprasmlist,href.base);
  136. cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,href,location.register);
  137. end
  138. else
  139. begin
  140. reference_reset_symbol(href,
  141. objectlibrary.newasmsymboldata(tobjectdef(tclassrefdef(resulttype.def).pointertype.def).vmt_mangledname),0);
  142. location.register:=rg.getaddressregister(exprasmlist);
  143. cg.a_loadaddr_ref_reg(exprasmlist,href,location.register);
  144. end;
  145. end;
  146. {*****************************************************************************
  147. TCGADDRNODE
  148. *****************************************************************************}
  149. procedure tcgaddrnode.pass_2;
  150. begin
  151. secondpass(left);
  152. { when loading procvar we do nothing with this node, so load the
  153. location of left }
  154. if nf_procvarload in flags then
  155. begin
  156. location_copy(location,left.location);
  157. exit;
  158. end;
  159. location_release(exprasmlist,left.location);
  160. location_reset(location,LOC_REGISTER,OS_ADDR);
  161. location.register:=rg.getaddressregister(exprasmlist);
  162. {@ on a procvar means returning an address to the procedure that
  163. is stored in it.}
  164. { yes but left.symtableentry can be nil
  165. for example on self !! }
  166. { symtableentry can be also invalid, if left is no tree node }
  167. if (m_tp_procvar in aktmodeswitches) and
  168. (left.nodetype=loadn) and
  169. assigned(tloadnode(left).symtableentry) and
  170. (tloadnode(left).symtableentry.typ=varsym) and
  171. (tvarsym(tloadnode(left).symtableentry).vartype.def.deftype=procvardef) then
  172. cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.reference,
  173. location.register)
  174. else
  175. begin
  176. cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,
  177. location.register);
  178. end;
  179. end;
  180. {*****************************************************************************
  181. TCGDOUBLEADDRNODE
  182. *****************************************************************************}
  183. procedure tcgdoubleaddrnode.pass_2;
  184. begin
  185. secondpass(left);
  186. location_release(exprasmlist,left.location);
  187. location_reset(location,LOC_REGISTER,OS_ADDR);
  188. location.register:=rg.getaddressregister(exprasmlist);
  189. cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,
  190. location.register);
  191. end;
  192. {*****************************************************************************
  193. TCGDEREFNODE
  194. *****************************************************************************}
  195. procedure tcgderefnode.pass_2;
  196. begin
  197. secondpass(left);
  198. location_reset(location,LOC_REFERENCE,def_cgsize(resulttype.def));
  199. case left.location.loc of
  200. LOC_REGISTER:
  201. begin
  202. if not rg.isaddressregister(left.location.register) then
  203. begin
  204. location_release(exprasmlist,left.location);
  205. location.reference.base := rg.getaddressregister(exprasmlist);
  206. cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.register,
  207. location.reference.base);
  208. end
  209. else
  210. location.reference.base := left.location.register;
  211. end;
  212. LOC_CREGISTER,
  213. LOC_CREFERENCE,
  214. LOC_REFERENCE:
  215. begin
  216. location_release(exprasmlist,left.location);
  217. location.reference.base:=rg.getaddressregister(exprasmlist);
  218. cg.a_load_loc_reg(exprasmlist,OS_ADDR,left.location,location.reference.base);
  219. end;
  220. end;
  221. if (cs_gdb_heaptrc in aktglobalswitches) and
  222. (cs_checkpointer in aktglobalswitches) and
  223. not(cs_compilesystem in aktmoduleswitches) and
  224. (not tpointerdef(left.resulttype.def).is_far) then
  225. begin
  226. cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paramanager.getintparaloc(exprasmlist,1));
  227. cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
  228. paramanager.freeintparaloc(exprasmlist,1);
  229. end;
  230. end;
  231. {*****************************************************************************
  232. TCGSUBSCRIPTNODE
  233. *****************************************************************************}
  234. procedure tcgsubscriptnode.pass_2;
  235. begin
  236. secondpass(left);
  237. if codegenerror then
  238. exit;
  239. { classes and interfaces must be dereferenced implicit }
  240. if is_class_or_interface(left.resulttype.def) then
  241. begin
  242. location_reset(location,LOC_REFERENCE,def_cgsize(resulttype.def));
  243. case left.location.loc of
  244. LOC_CREGISTER,
  245. LOC_REGISTER:
  246. begin
  247. if not rg.isaddressregister(left.location.register) then
  248. begin
  249. location_release(exprasmlist,left.location);
  250. location.reference.base:=rg.getaddressregister(exprasmlist);
  251. cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,
  252. left.location.register,location.reference.base);
  253. end
  254. else
  255. location.reference.base := left.location.register;
  256. end;
  257. LOC_CREFERENCE,
  258. LOC_REFERENCE:
  259. begin
  260. location_release(exprasmlist,left.location);
  261. location.reference.base:=rg.getaddressregister(exprasmlist);
  262. cg.a_load_loc_reg(exprasmlist,OS_ADDR,left.location,location.reference.base);
  263. end;
  264. end;
  265. { implicit deferencing }
  266. if (cs_gdb_heaptrc in aktglobalswitches) and
  267. (cs_checkpointer in aktglobalswitches) and
  268. not(cs_compilesystem in aktmoduleswitches) then
  269. begin
  270. cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paramanager.getintparaloc(exprasmlist,1));
  271. cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
  272. paramanager.freeintparaloc(exprasmlist,1);
  273. end;
  274. end
  275. else if is_interfacecom(left.resulttype.def) then
  276. begin
  277. tg.GetTemp(exprasmlist,pointer_size,tt_interfacecom,location.reference);
  278. cg.a_load_loc_ref(exprasmlist,OS_ADDR,left.location,location.reference);
  279. { implicit deferencing also for interfaces }
  280. if (cs_gdb_heaptrc in aktglobalswitches) and
  281. (cs_checkpointer in aktglobalswitches) and
  282. not(cs_compilesystem in aktmoduleswitches) then
  283. begin
  284. cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paramanager.getintparaloc(exprasmlist,1));
  285. cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
  286. paramanager.freeintparaloc(exprasmlist,1);
  287. end;
  288. end
  289. else
  290. location_copy(location,left.location);
  291. inc(location.reference.offset,vs.address);
  292. { also update the size of the location }
  293. location.size:=def_cgsize(resulttype.def);
  294. end;
  295. {*****************************************************************************
  296. TCGWITHNODE
  297. *****************************************************************************}
  298. procedure tcgwithnode.pass_2;
  299. {$ifdef GDB}
  300. const
  301. withlevel : longint = 0;
  302. var
  303. withstartlabel,withendlabel : tasmlabel;
  304. pp : pchar;
  305. mangled_length : longint;
  306. {$endif GDB}
  307. begin
  308. location_reset(location,LOC_VOID,OS_NO);
  309. {$ifdef GDB}
  310. if (cs_debuginfo in aktmoduleswitches) then
  311. begin
  312. { load reference }
  313. if (withrefnode.nodetype=derefn) and
  314. (tderefnode(withrefnode).left.nodetype=temprefn) then
  315. secondpass(withrefnode);
  316. inc(withlevel);
  317. objectlibrary.getaddrlabel(withstartlabel);
  318. objectlibrary.getaddrlabel(withendlabel);
  319. cg.a_label(exprasmlist,withstartlabel);
  320. withdebugList.concat(Tai_stabs.Create(strpnew(
  321. '"with'+tostr(withlevel)+':'+tostr(symtablestack.getnewtypecount)+
  322. '=*'+tstoreddef(left.resulttype.def).numberstring+'",'+
  323. tostr(N_LSYM)+',0,0,'+tostr(withrefnode.location.reference.offset))));
  324. mangled_length:=length(current_procdef.mangledname);
  325. getmem(pp,mangled_length+50);
  326. strpcopy(pp,'192,0,0,'+withstartlabel.name);
  327. if (target_info.use_function_relative_addresses) then
  328. begin
  329. strpcopy(strend(pp),'-');
  330. strpcopy(strend(pp),current_procdef.mangledname);
  331. end;
  332. withdebugList.concat(Tai_stabn.Create(strnew(pp)));
  333. end;
  334. {$endif GDB}
  335. if assigned(left) then
  336. secondpass(left);
  337. {$ifdef GDB}
  338. if (cs_debuginfo in aktmoduleswitches) then
  339. begin
  340. cg.a_label(exprasmlist,withendlabel);
  341. strpcopy(pp,'224,0,0,'+withendlabel.name);
  342. if (target_info.use_function_relative_addresses) then
  343. begin
  344. strpcopy(strend(pp),'-');
  345. strpcopy(strend(pp),current_procdef.mangledname);
  346. end;
  347. withdebugList.concat(Tai_stabn.Create(strnew(pp)));
  348. freemem(pp,mangled_length+50);
  349. dec(withlevel);
  350. end;
  351. {$endif GDB}
  352. end;
  353. {*****************************************************************************
  354. TCGVECNODE
  355. *****************************************************************************}
  356. function tcgvecnode.get_mul_size : longint;
  357. begin
  358. if nf_memindex in flags then
  359. get_mul_size:=1
  360. else
  361. begin
  362. if (left.resulttype.def.deftype=arraydef) then
  363. get_mul_size:=tarraydef(left.resulttype.def).elesize
  364. else
  365. get_mul_size:=resulttype.def.size;
  366. end
  367. end;
  368. procedure tcgvecnode.update_reference_reg_mul(reg:tregister;l:aword);
  369. begin
  370. if location.reference.base.number=NR_NO then
  371. begin
  372. cg.a_op_const_reg(exprasmlist,OP_IMUL,OS_ADDR,l,reg);
  373. location.reference.base:=reg;
  374. end
  375. else if location.reference.index.number=NR_NO then
  376. begin
  377. cg.a_op_const_reg(exprasmlist,OP_IMUL,OS_ADDR,l,reg);
  378. location.reference.index:=reg;
  379. end
  380. else
  381. begin
  382. cg.a_loadaddr_ref_reg(exprasmlist,location.reference,location.reference.index);
  383. rg.ungetregisterint(exprasmlist,location.reference.base);
  384. reference_reset_base(location.reference,location.reference.index,0);
  385. { insert new index register }
  386. cg.a_op_const_reg(exprasmlist,OP_IMUL,OS_ADDR,l,reg);
  387. location.reference.index:=reg;
  388. end;
  389. end;
  390. procedure tcgvecnode.second_wideansistring;
  391. begin
  392. end;
  393. procedure tcgvecnode.second_dynamicarray;
  394. begin
  395. end;
  396. procedure tcgvecnode.rangecheck_array;
  397. var
  398. freereg : boolean;
  399. hightree : tnode;
  400. poslabel,
  401. neglabel : tasmlabel;
  402. hreg : tregister;
  403. i:Tsuperregister;
  404. {$ifndef newra}
  405. pushed : tpushedsavedint;
  406. {$endif}
  407. begin
  408. if is_open_array(left.resulttype.def) or
  409. is_array_of_const(left.resulttype.def) then
  410. begin
  411. { cdecl functions don't have high() so we can not check the range }
  412. if not(current_procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
  413. begin
  414. { Get high value }
  415. hightree:=load_high_value_node(tvarsym(tloadnode(left).symtableentry));
  416. { it must be available }
  417. if not assigned(hightree) then
  418. internalerror(200212201);
  419. firstpass(hightree);
  420. secondpass(hightree);
  421. { generate compares }
  422. freereg:=false;
  423. if (right.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  424. hreg:=right.location.register
  425. else
  426. begin
  427. {$ifdef newra}
  428. hreg:=rg.getregisterint(exprasmlist,OS_INT);
  429. {$else}
  430. hreg := cg.get_scratch_reg_int(exprasmlist,OS_INT);
  431. {$endif}
  432. freereg:=true;
  433. cg.a_load_loc_reg(exprasmlist,OS_INT,right.location,hreg);
  434. end;
  435. objectlibrary.getlabel(neglabel);
  436. objectlibrary.getlabel(poslabel);
  437. cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_LT,0,hreg,poslabel);
  438. cg.a_cmp_loc_reg_label(exprasmlist,OS_INT,OC_BE,hightree.location,hreg,neglabel);
  439. {$ifdef newra}
  440. if freereg then
  441. rg.ungetregisterint(exprasmlist,hreg);
  442. {$else}
  443. if freereg then
  444. cg.free_scratch_reg(exprasmlist,hreg);
  445. {$endif}
  446. cg.a_label(exprasmlist,poslabel);
  447. cg.a_call_name(exprasmlist,'FPC_RANGEERROR');
  448. cg.a_label(exprasmlist,neglabel);
  449. { release hightree }
  450. location_release(exprasmlist,hightree.location);
  451. hightree.free;
  452. end;
  453. end
  454. else
  455. if is_dynamic_array(left.resulttype.def) then
  456. begin
  457. {$ifndef newra}
  458. rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
  459. {$endif}
  460. cg.a_param_loc(exprasmlist,right.location,paramanager.getintparaloc(exprasmlist,2));
  461. cg.a_param_loc(exprasmlist,left.location,paramanager.getintparaloc(exprasmlist,1));
  462. {$ifdef newra}
  463. hreg.enum:=R_INTREGISTER;
  464. for i:=first_supreg to last_supreg do
  465. if i<>RS_FRAME_POINTER_REG then
  466. begin
  467. hreg.number:=i shl 8 or R_SUBWHOLE;
  468. rg.getexplicitregisterint(exprasmlist,hreg.number);
  469. end;
  470. {$else}
  471. rg.saveintregvars(exprasmlist,all_intregisters);
  472. {$endif}
  473. cg.a_call_name(exprasmlist,'FPC_DYNARRAY_RANGECHECK');
  474. paramanager.freeintparaloc(exprasmlist,2);
  475. paramanager.freeintparaloc(exprasmlist,1);
  476. {$ifdef newra}
  477. for i:=first_supreg to last_supreg do
  478. if i<>RS_FRAME_POINTER_REG then
  479. begin
  480. hreg.number:=i shl 8 or R_SUBWHOLE;
  481. rg.ungetregisterint(exprasmlist,hreg);
  482. end;
  483. {$else}
  484. rg.restoreusedintregisters(exprasmlist,pushed);
  485. {$endif}
  486. end
  487. else
  488. cg.g_rangecheck(exprasmlist,right.location,right.resulttype.def,left.resulttype.def);
  489. end;
  490. procedure tcgvecnode.pass_2;
  491. var
  492. extraoffset : longint;
  493. t : tnode;
  494. href : treference;
  495. {$ifdef newra}
  496. hreg:Tregister;
  497. i:Tsuperregister;
  498. {$else}
  499. pushed : tpushedsavedint;
  500. {$endif}
  501. isjump : boolean;
  502. otl,ofl : tasmlabel;
  503. newsize : tcgsize;
  504. pushedregs : tmaybesave;
  505. begin
  506. newsize:=def_cgsize(resulttype.def);
  507. secondpass(left);
  508. if left.location.loc=LOC_CREFERENCE then
  509. location_reset(location,LOC_CREFERENCE,newsize)
  510. else
  511. location_reset(location,LOC_REFERENCE,newsize);
  512. { an ansistring needs to be dereferenced }
  513. if is_ansistring(left.resulttype.def) or
  514. is_widestring(left.resulttype.def) then
  515. begin
  516. if nf_callunique in flags then
  517. begin
  518. if left.location.loc<>LOC_REFERENCE then
  519. internalerror(200304236);
  520. {$ifndef newra}
  521. rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
  522. {$endif}
  523. cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(exprasmlist,1));
  524. {$ifdef newra}
  525. hreg.enum:=R_INTREGISTER;
  526. for i:=first_supreg to last_supreg do
  527. if i<>RS_FRAME_POINTER_REG then
  528. begin
  529. hreg.number:=i shl 8 or R_SUBWHOLE;
  530. rg.getexplicitregisterint(exprasmlist,hreg.number);
  531. end;
  532. {$else}
  533. rg.saveintregvars(exprasmlist,all_intregisters);
  534. {$endif}
  535. cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_UNIQUE');
  536. paramanager.freeintparaloc(exprasmlist,1);
  537. {$ifdef newra}
  538. for i:=first_supreg to last_supreg do
  539. if i<>RS_FRAME_POINTER_REG then
  540. begin
  541. hreg.number:=i shl 8 or R_SUBWHOLE;
  542. rg.ungetregisterint(exprasmlist,hreg);
  543. end;
  544. {$else}
  545. rg.restoreusedintregisters(exprasmlist,pushed);
  546. {$endif}
  547. end;
  548. case left.location.loc of
  549. LOC_REGISTER,
  550. LOC_CREGISTER :
  551. location.reference.base:=left.location.register;
  552. LOC_CREFERENCE,
  553. LOC_REFERENCE :
  554. begin
  555. location_release(exprasmlist,left.location);
  556. location.reference.base:=rg.getaddressregister(exprasmlist);
  557. cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.reference,location.reference.base);
  558. end;
  559. else
  560. internalerror(2002032218);
  561. end;
  562. { check for a zero length string,
  563. we can use the ansistring routine here }
  564. if (cs_check_range in aktlocalswitches) then
  565. begin
  566. {$ifndef newra}
  567. rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
  568. {$endif}
  569. cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,paramanager.getintparaloc(exprasmlist,1));
  570. {$ifdef newra}
  571. hreg.enum:=R_INTREGISTER;
  572. for i:=first_supreg to last_supreg do
  573. if i<>RS_FRAME_POINTER_REG then
  574. begin
  575. hreg.number:=i shl 8 or R_SUBWHOLE;
  576. rg.getexplicitregisterint(exprasmlist,hreg.number);
  577. end;
  578. {$else}
  579. rg.saveintregvars(exprasmlist,all_intregisters);
  580. {$endif}
  581. cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_CHECKZERO');
  582. paramanager.freeintparaloc(exprasmlist,1);
  583. {$ifdef newra}
  584. for i:=first_supreg to last_supreg do
  585. if i<>RS_FRAME_POINTER_REG then
  586. begin
  587. hreg.number:=i shl 8 or R_SUBWHOLE;
  588. rg.ungetregisterint(exprasmlist,hreg);
  589. end;
  590. {$else}
  591. rg.restoreusedintregisters(exprasmlist,pushed);
  592. {$endif}
  593. end;
  594. { in ansistrings/widestrings S[1] is p<w>char(S)[0] !! }
  595. if is_ansistring(left.resulttype.def) then
  596. dec(location.reference.offset)
  597. else
  598. dec(location.reference.offset,2);
  599. end
  600. else if is_dynamic_array(left.resulttype.def) then
  601. begin
  602. case left.location.loc of
  603. LOC_REGISTER,
  604. LOC_CREGISTER :
  605. location.reference.base:=left.location.register;
  606. LOC_REFERENCE,
  607. LOC_CREFERENCE :
  608. begin
  609. location_release(exprasmlist,left.location);
  610. location.reference.base:=rg.getaddressregister(exprasmlist);
  611. cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,
  612. left.location.reference,location.reference.base);
  613. end;
  614. else
  615. internalerror(2002032219);
  616. end;
  617. end
  618. else
  619. location_copy(location,left.location);
  620. { offset can only differ from 0 if arraydef }
  621. if (left.resulttype.def.deftype=arraydef) and
  622. not(is_dynamic_array(left.resulttype.def)) then
  623. dec(location.reference.offset,get_mul_size*tarraydef(left.resulttype.def).lowrange);
  624. if right.nodetype=ordconstn then
  625. begin
  626. { offset can only differ from 0 if arraydef }
  627. case left.resulttype.def.deftype of
  628. arraydef :
  629. begin
  630. if not(is_open_array(left.resulttype.def)) and
  631. not(is_array_of_const(left.resulttype.def)) and
  632. not(is_dynamic_array(left.resulttype.def)) then
  633. begin
  634. if (tordconstnode(right).value>tarraydef(left.resulttype.def).highrange) or
  635. (tordconstnode(right).value<tarraydef(left.resulttype.def).lowrange) then
  636. begin
  637. { this should be caught in the resulttypepass! (JM) }
  638. if (cs_check_range in aktlocalswitches) then
  639. CGMessage(parser_e_range_check_error)
  640. else
  641. CGMessage(parser_w_range_check_error);
  642. end;
  643. end
  644. else
  645. begin
  646. { range checking for open and dynamic arrays needs
  647. runtime code }
  648. secondpass(right);
  649. if (cs_check_range in aktlocalswitches) then
  650. rangecheck_array;
  651. end;
  652. end;
  653. stringdef :
  654. begin
  655. if (cs_check_range in aktlocalswitches) then
  656. begin
  657. case tstringdef(left.resulttype.def).string_typ of
  658. { it's the same for ansi- and wide strings }
  659. st_widestring,
  660. st_ansistring:
  661. begin
  662. {$ifndef newra}
  663. rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
  664. {$endif}
  665. cg.a_param_const(exprasmlist,OS_INT,tordconstnode(right).value,paramanager.getintparaloc(exprasmlist,2));
  666. href:=location.reference;
  667. dec(href.offset,7);
  668. cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(exprasmlist,1));
  669. {$ifdef newra}
  670. hreg.enum:=R_INTREGISTER;
  671. for i:=first_supreg to last_supreg do
  672. if i<>RS_FRAME_POINTER_REG then
  673. begin
  674. hreg.number:=i shl 8 or R_SUBWHOLE;
  675. rg.getexplicitregisterint(exprasmlist,hreg.number);
  676. end;
  677. {$else}
  678. rg.saveintregvars(exprasmlist,all_intregisters);
  679. {$endif}
  680. cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
  681. paramanager.freeintparaloc(exprasmlist,2);
  682. paramanager.freeintparaloc(exprasmlist,1);
  683. {$ifdef newra}
  684. for i:=first_supreg to last_supreg do
  685. if i<>RS_FRAME_POINTER_REG then
  686. begin
  687. hreg.number:=i shl 8 or R_SUBWHOLE;
  688. rg.ungetregisterint(exprasmlist,hreg);
  689. end;
  690. {$else}
  691. rg.restoreusedintregisters(exprasmlist,pushed);
  692. {$endif}
  693. end;
  694. st_shortstring:
  695. begin
  696. {!!!!!!!!!!!!!!!!!}
  697. end;
  698. st_longstring:
  699. begin
  700. {!!!!!!!!!!!!!!!!!}
  701. end;
  702. end;
  703. end;
  704. end;
  705. end;
  706. inc(location.reference.offset,
  707. get_mul_size*tordconstnode(right).value);
  708. end
  709. else
  710. { not nodetype=ordconstn }
  711. begin
  712. if (cs_regalloc in aktglobalswitches) and
  713. { if we do range checking, we don't }
  714. { need that fancy code (it would be }
  715. { buggy) }
  716. not(cs_check_range in aktlocalswitches) and
  717. (left.resulttype.def.deftype=arraydef) then
  718. begin
  719. extraoffset:=0;
  720. if (right.nodetype=addn) then
  721. begin
  722. if taddnode(right).right.nodetype=ordconstn then
  723. begin
  724. extraoffset:=tordconstnode(taddnode(right).right).value;
  725. t:=taddnode(right).left;
  726. { First pass processed this with the assumption }
  727. { that there was an add node which may require an }
  728. { extra register. Fake it or die with IE10 (JM) }
  729. t.registers32 := taddnode(right).registers32;
  730. taddnode(right).left:=nil;
  731. right.free;
  732. right:=t;
  733. end
  734. else if taddnode(right).left.nodetype=ordconstn then
  735. begin
  736. extraoffset:=tordconstnode(taddnode(right).left).value;
  737. t:=taddnode(right).right;
  738. t.registers32 := right.registers32;
  739. taddnode(right).right:=nil;
  740. right.free;
  741. right:=t;
  742. end;
  743. end
  744. else if (right.nodetype=subn) then
  745. begin
  746. if taddnode(right).right.nodetype=ordconstn then
  747. begin
  748. extraoffset:=-tordconstnode(taddnode(right).right).value;
  749. t:=taddnode(right).left;
  750. t.registers32 := right.registers32;
  751. taddnode(right).left:=nil;
  752. right.free;
  753. right:=t;
  754. end
  755. { You also have to negate right.right in this case! I can't add an
  756. unaryminusn without causing a crash, so I've disabled it (JM)
  757. else if right.left.nodetype=ordconstn then
  758. begin
  759. extraoffset:=right.left.value;
  760. t:=right.right;
  761. t^.registers32 := right.registers32;
  762. putnode(right);
  763. putnode(right.left);
  764. right:=t;
  765. end;}
  766. end;
  767. inc(location.reference.offset,
  768. get_mul_size*extraoffset);
  769. end;
  770. { calculate from left to right }
  771. if not(location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
  772. internalerror(200304237);
  773. isjump:=(right.location.loc=LOC_JUMP);
  774. if isjump then
  775. begin
  776. otl:=truelabel;
  777. objectlibrary.getlabel(truelabel);
  778. ofl:=falselabel;
  779. objectlibrary.getlabel(falselabel);
  780. end;
  781. {$ifndef newra}
  782. maybe_save(exprasmlist,right.registers32,location,pushedregs);
  783. {$endif}
  784. secondpass(right);
  785. {$ifndef newra}
  786. maybe_restore(exprasmlist,location,pushedregs);
  787. {$endif}
  788. if cs_check_range in aktlocalswitches then
  789. begin
  790. if left.resulttype.def.deftype=arraydef then
  791. rangecheck_array;
  792. end;
  793. location_force_reg(exprasmlist,right.location,OS_32,false);
  794. if isjump then
  795. begin
  796. truelabel:=otl;
  797. falselabel:=ofl;
  798. end;
  799. { produce possible range check code: }
  800. if cs_check_range in aktlocalswitches then
  801. begin
  802. if left.resulttype.def.deftype=arraydef then
  803. begin
  804. { done defore (PM) }
  805. end
  806. else if (left.resulttype.def.deftype=stringdef) then
  807. begin
  808. case tstringdef(left.resulttype.def).string_typ of
  809. { it's the same for ansi- and wide strings }
  810. st_widestring,
  811. st_ansistring:
  812. begin
  813. {$ifndef newra}
  814. rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
  815. {$endif}
  816. cg.a_param_reg(exprasmlist,OS_INT,right.location.register,paramanager.getintparaloc(exprasmlist,2));
  817. href:=location.reference;
  818. dec(href.offset,7);
  819. cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(exprasmlist,1));
  820. {$ifdef newra}
  821. hreg.enum:=R_INTREGISTER;
  822. for i:=first_supreg to last_supreg do
  823. if i<>RS_FRAME_POINTER_REG then
  824. begin
  825. hreg.number:=i shl 8 or R_SUBWHOLE;
  826. rg.getexplicitregisterint(exprasmlist,hreg.number);
  827. end;
  828. {$else}
  829. rg.saveintregvars(exprasmlist,all_intregisters);
  830. {$endif}
  831. cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
  832. paramanager.freeintparaloc(exprasmlist,2);
  833. paramanager.freeintparaloc(exprasmlist,1);
  834. {$ifdef newra}
  835. for i:=first_supreg to last_supreg do
  836. if i<>RS_FRAME_POINTER_REG then
  837. begin
  838. hreg.number:=i shl 8 or R_SUBWHOLE;
  839. rg.ungetregisterint(exprasmlist,hreg);
  840. end;
  841. {$else}
  842. rg.restoreusedintregisters(exprasmlist,pushed);
  843. {$endif}
  844. end;
  845. st_shortstring:
  846. begin
  847. {!!!!!!!!!!!!!!!!!}
  848. end;
  849. st_longstring:
  850. begin
  851. {!!!!!!!!!!!!!!!!!}
  852. end;
  853. end;
  854. end;
  855. end;
  856. { insert the register and the multiplication factor in the
  857. reference }
  858. update_reference_reg_mul(right.location.register,get_mul_size);
  859. end;
  860. location.size:=newsize;
  861. end;
  862. begin
  863. cloadvmtaddrnode:=tcgloadvmtaddrnode;
  864. caddrnode:=tcgaddrnode;
  865. cdoubleaddrnode:=tcgdoubleaddrnode;
  866. cderefnode:=tcgderefnode;
  867. csubscriptnode:=tcgsubscriptnode;
  868. cwithnode:=tcgwithnode;
  869. cvecnode:=tcgvecnode;
  870. end.
  871. {
  872. $Log$
  873. Revision 1.60 2003-06-07 18:57:04 jonas
  874. + added freeintparaloc
  875. * ppc get/freeintparaloc now check whether the parameter regs are
  876. properly allocated/deallocated (and get an extra list para)
  877. * ppc a_call_* now internalerrors if pi_do_call is not yet set
  878. * fixed lot of missing pi_do_call's
  879. Revision 1.59 2003/06/03 21:11:09 peter
  880. * cg.a_load_* get a from and to size specifier
  881. * makeregsize only accepts newregister
  882. * i386 uses generic tcgnotnode,tcgunaryminus
  883. Revision 1.58 2003/06/03 13:01:59 daniel
  884. * Register allocator finished
  885. Revision 1.57 2003/06/02 22:35:45 florian
  886. * better handling of CREGISTER in subscript nodes
  887. Revision 1.56 2003/06/01 21:38:06 peter
  888. * getregisterfpu size parameter added
  889. * op_const_reg size parameter added
  890. * sparc updates
  891. Revision 1.55 2003/05/30 23:49:18 jonas
  892. * a_load_loc_reg now has an extra size parameter for the destination
  893. register (properly fixes what I worked around in revision 1.106 of
  894. ncgutil.pas)
  895. Revision 1.54 2003/05/15 16:10:37 florian
  896. * fixed getintparaloc call for ansi- and widestring range checking
  897. Revision 1.53 2003/05/11 21:37:03 peter
  898. * moved implicit exception frame from ncgutil to psub
  899. * constructor/destructor helpers moved from cobj/ncgutil to psub
  900. Revision 1.52 2003/05/11 14:45:12 peter
  901. * tloadnode does not support objectsymtable,withsymtable anymore
  902. * withnode cleanup
  903. * direct with rewritten to use temprefnode
  904. Revision 1.51 2003/05/09 17:47:02 peter
  905. * self moved to hidden parameter
  906. * removed hdisposen,hnewn,selfn
  907. Revision 1.50 2003/05/07 09:16:23 mazen
  908. - non used units removed from uses clause
  909. Revision 1.49 2003/04/27 11:21:33 peter
  910. * aktprocdef renamed to current_procdef
  911. * procinfo renamed to current_procinfo
  912. * procinfo will now be stored in current_module so it can be
  913. cleaned up properly
  914. * gen_main_procsym changed to create_main_proc and release_main_proc
  915. to also generate a tprocinfo structure
  916. * fixed unit implicit initfinal
  917. Revision 1.48 2003/04/22 23:50:22 peter
  918. * firstpass uses expectloc
  919. * checks if there are differences between the expectloc and
  920. location.loc from secondpass in EXTDEBUG
  921. Revision 1.47 2003/04/22 13:47:08 peter
  922. * fixed C style array of const
  923. * fixed C array passing
  924. * fixed left to right with high parameters
  925. Revision 1.46 2003/04/22 10:09:35 daniel
  926. + Implemented the actual register allocator
  927. + Scratch registers unavailable when new register allocator used
  928. + maybe_save/maybe_restore unavailable when new register allocator used
  929. Revision 1.45 2003/04/06 21:11:23 olle
  930. * changed newasmsymbol to newasmsymboldata for data symbols
  931. Revision 1.44 2003/03/28 19:16:56 peter
  932. * generic constructor working for i386
  933. * remove fixed self register
  934. * esi added as address register for i386
  935. Revision 1.43 2003/03/12 22:43:38 jonas
  936. * more powerpc and generic fixes related to the new register allocator
  937. Revision 1.42 2003/02/19 22:00:14 daniel
  938. * Code generator converted to new register notation
  939. - Horribily outdated todo.txt removed
  940. Revision 1.41 2003/01/30 21:46:57 peter
  941. * self fixes for static methods (merged)
  942. Revision 1.40 2003/01/08 18:43:56 daniel
  943. * Tregister changed into a record
  944. Revision 1.39 2002/12/20 18:13:19 peter
  945. * no rangecheck for openarrays with cdecl
  946. Revision 1.38 2002/12/17 22:19:33 peter
  947. * fixed pushing of records>8 bytes with stdcall
  948. * simplified hightree loading
  949. Revision 1.37 2002/12/08 13:39:03 carl
  950. + some documentation added
  951. Revision 1.36 2002/12/07 14:14:19 carl
  952. * bugfix on invalid typecast
  953. Revision 1.35 2002/11/25 17:43:18 peter
  954. * splitted defbase in defutil,symutil,defcmp
  955. * merged isconvertable and is_equal into compare_defs(_ext)
  956. * made operator search faster by walking the list only once
  957. Revision 1.34 2002/11/24 18:19:20 carl
  958. + checkpointer for interfaces also
  959. Revision 1.33 2002/11/23 22:50:06 carl
  960. * some small speed optimizations
  961. + added several new warnings/hints
  962. Revision 1.32 2002/11/15 01:58:51 peter
  963. * merged changes from 1.0.7 up to 04-11
  964. - -V option for generating bug report tracing
  965. - more tracing for option parsing
  966. - errors for cdecl and high()
  967. - win32 import stabs
  968. - win32 records<=8 are returned in eax:edx (turned off by default)
  969. - heaptrc update
  970. - more info for temp management in .s file with EXTDEBUG
  971. Revision 1.31 2002/10/09 20:24:47 florian
  972. + range checking for dyn. arrays
  973. Revision 1.30 2002/10/07 21:30:45 peter
  974. * rangecheck for open arrays added
  975. Revision 1.29 2002/10/05 12:43:25 carl
  976. * fixes for Delphi 6 compilation
  977. (warning : Some features do not work under Delphi)
  978. Revision 1.28 2002/09/17 18:54:02 jonas
  979. * a_load_reg_reg() now has two size parameters: source and dest. This
  980. allows some optimizations on architectures that don't encode the
  981. register size in the register name.
  982. Revision 1.27 2002/09/07 15:25:03 peter
  983. * old logs removed and tabs fixed
  984. Revision 1.26 2002/09/01 18:46:01 peter
  985. * fixed generic tcgvecnode
  986. * move code that updates a reference with index register and multiplier
  987. to separate method so it can be overriden for scaled indexing
  988. * i386 uses generic tcgvecnode
  989. Revision 1.25 2002/08/23 16:14:48 peter
  990. * tempgen cleanup
  991. * tt_noreuse temp type added that will be used in genentrycode
  992. Revision 1.24 2002/08/15 08:13:54 carl
  993. - a_load_sym_ofs_reg removed
  994. * loadvmt now calls loadaddr_ref_reg instead
  995. Revision 1.23 2002/08/11 14:32:26 peter
  996. * renamed current_library to objectlibrary
  997. Revision 1.22 2002/08/11 13:24:12 peter
  998. * saving of asmsymbols in ppu supported
  999. * asmsymbollist global is removed and moved into a new class
  1000. tasmlibrarydata that will hold the info of a .a file which
  1001. corresponds with a single module. Added librarydata to tmodule
  1002. to keep the library info stored for the module. In the future the
  1003. objectfiles will also be stored to the tasmlibrarydata class
  1004. * all getlabel/newasmsymbol and friends are moved to the new class
  1005. Revision 1.21 2002/08/11 11:36:57 jonas
  1006. * always first try to use base and only then index
  1007. Revision 1.20 2002/08/11 06:14:40 florian
  1008. * fixed powerpc compilation problems
  1009. Revision 1.19 2002/08/10 14:46:29 carl
  1010. + moved target_cpu_string to cpuinfo
  1011. * renamed asmmode enum.
  1012. * assembler reader has now less ifdef's
  1013. * move from nppcmem.pas -> ncgmem.pas vec. node.
  1014. Revision 1.18 2002/07/28 21:34:31 florian
  1015. * more powerpc fixes
  1016. + dummy tcgvecnode
  1017. Revision 1.17 2002/07/11 14:41:28 florian
  1018. * start of the new generic parameter handling
  1019. Revision 1.16 2002/07/07 09:52:32 florian
  1020. * powerpc target fixed, very simple units can be compiled
  1021. * some basic stuff for better callparanode handling, far from being finished
  1022. Revision 1.15 2002/07/01 18:46:23 peter
  1023. * internal linker
  1024. * reorganized aasm layer
  1025. Revision 1.14 2002/07/01 16:23:53 peter
  1026. * cg64 patch
  1027. * basics for currency
  1028. * asnode updates for class and interface (not finished)
  1029. Revision 1.13 2002/05/20 13:30:40 carl
  1030. * bugfix of hdisponen (base must be set, not index)
  1031. * more portability fixes
  1032. Revision 1.12 2002/05/18 13:34:09 peter
  1033. * readded missing revisions
  1034. Revision 1.11 2002/05/16 19:46:37 carl
  1035. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1036. + try to fix temp allocation (still in ifdef)
  1037. + generic constructor calls
  1038. + start of tassembler / tmodulebase class cleanup
  1039. Revision 1.9 2002/05/12 16:53:07 peter
  1040. * moved entry and exitcode to ncgutil and cgobj
  1041. * foreach gets extra argument for passing local data to the
  1042. iterator function
  1043. * -CR checks also class typecasts at runtime by changing them
  1044. into as
  1045. * fixed compiler to cycle with the -CR option
  1046. * fixed stabs with elf writer, finally the global variables can
  1047. be watched
  1048. * removed a lot of routines from cga unit and replaced them by
  1049. calls to cgobj
  1050. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  1051. u32bit then the other is typecasted also to u32bit without giving
  1052. a rangecheck warning/error.
  1053. * fixed pascal calling method with reversing also the high tree in
  1054. the parast, detected by tcalcst3 test
  1055. Revision 1.8 2002/04/20 21:32:23 carl
  1056. + generic FPC_CHECKPOINTER
  1057. + first parameter offset in stack now portable
  1058. * rename some constants
  1059. + move some cpu stuff to other units
  1060. - remove unused constents
  1061. * fix stacksize for some targets
  1062. * fix generic size problems which depend now on EXTEND_SIZE constant
  1063. Revision 1.7 2002/04/15 18:58:47 carl
  1064. + target_info.size_of_pointer -> pointer_Size
  1065. Revision 1.6 2002/04/04 19:05:57 peter
  1066. * removed unused units
  1067. * use tlocation.size in cg.a_*loc*() routines
  1068. }