cg386mem.pas 32 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 by Florian Klaempfl
  4. Generate i386 assembler for in memory related nodes
  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 cg386mem;
  19. interface
  20. uses
  21. tree;
  22. procedure secondloadvmt(var p : ptree);
  23. procedure secondhnewn(var p : ptree);
  24. procedure secondnewn(var p : ptree);
  25. procedure secondhdisposen(var p : ptree);
  26. procedure secondsimplenewdispose(var p : ptree);
  27. procedure secondaddr(var p : ptree);
  28. procedure seconddoubleaddr(var p : ptree);
  29. procedure secondderef(var p : ptree);
  30. procedure secondsubscriptn(var p : ptree);
  31. procedure secondvecn(var p : ptree);
  32. procedure secondselfn(var p : ptree);
  33. procedure secondwith(var p : ptree);
  34. implementation
  35. uses
  36. globtype,systems,
  37. cobjects,verbose,globals,
  38. symtable,aasm,types,
  39. hcodegen,temp_gen,pass_2,
  40. i386,cgai386,tgeni386;
  41. {*****************************************************************************
  42. SecondLoadVMT
  43. *****************************************************************************}
  44. procedure secondloadvmt(var p : ptree);
  45. begin
  46. p^.location.register:=getregister32;
  47. exprasmlist^.concat(new(pai386,op_csymbol_reg(A_MOV,
  48. S_L,newcsymbol(pobjectdef(pclassrefdef(p^.resulttype)^.definition)^.vmt_mangledname,0),
  49. p^.location.register)));
  50. end;
  51. {*****************************************************************************
  52. SecondHNewN
  53. *****************************************************************************}
  54. procedure secondhnewn(var p : ptree);
  55. begin
  56. end;
  57. {*****************************************************************************
  58. SecondNewN
  59. *****************************************************************************}
  60. procedure secondnewn(var p : ptree);
  61. var
  62. pushed : tpushed;
  63. r : preference;
  64. begin
  65. if assigned(p^.left) then
  66. begin
  67. secondpass(p^.left);
  68. p^.location.register:=p^.left^.location.register;
  69. end
  70. else
  71. begin
  72. pushusedregisters(pushed,$ff);
  73. { code copied from simplenewdispose PM }
  74. { determines the size of the mem block }
  75. push_int(ppointerdef(p^.resulttype)^.definition^.size);
  76. gettempofsizereference(target_os.size_of_pointer,p^.location.reference);
  77. emitpushreferenceaddr(exprasmlist,p^.location.reference);
  78. emitcall('FPC_GETMEM',true);
  79. if ppointerdef(p^.resulttype)^.definition^.needs_inittable then
  80. begin
  81. new(r);
  82. reset_reference(r^);
  83. r^.symbol:=stringdup(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label));
  84. emitpushreferenceaddr(exprasmlist,r^);
  85. { push pointer adress }
  86. emitpushreferenceaddr(exprasmlist,p^.location.reference);
  87. stringdispose(r^.symbol);
  88. dispose(r);
  89. emitcall('FPC_INITIALIZE',true);
  90. end;
  91. popusedregisters(pushed);
  92. { may be load ESI }
  93. maybe_loadesi;
  94. end;
  95. if codegenerror then
  96. exit;
  97. end;
  98. {*****************************************************************************
  99. SecondDisposeN
  100. *****************************************************************************}
  101. procedure secondhdisposen(var p : ptree);
  102. begin
  103. secondpass(p^.left);
  104. if codegenerror then
  105. exit;
  106. clear_reference(p^.location.reference);
  107. case p^.left^.location.loc of
  108. LOC_REGISTER,
  109. LOC_CREGISTER:
  110. begin
  111. p^.location.reference.index:=getregister32;
  112. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
  113. p^.left^.location.register,
  114. p^.location.reference.index)));
  115. end;
  116. LOC_MEM,LOC_REFERENCE :
  117. begin
  118. del_reference(p^.left^.location.reference);
  119. p^.location.reference.index:=getregister32;
  120. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
  121. p^.location.reference.index)));
  122. end;
  123. end;
  124. end;
  125. {*****************************************************************************
  126. SecondNewDispose
  127. *****************************************************************************}
  128. procedure secondsimplenewdispose(var p : ptree);
  129. var
  130. pushed : tpushed;
  131. r : preference;
  132. begin
  133. secondpass(p^.left);
  134. if codegenerror then
  135. exit;
  136. pushusedregisters(pushed,$ff);
  137. { determines the size of the mem block }
  138. push_int(ppointerdef(p^.left^.resulttype)^.definition^.size);
  139. { push pointer adress }
  140. case p^.left^.location.loc of
  141. LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,
  142. p^.left^.location.register)));
  143. LOC_REFERENCE:
  144. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  145. end;
  146. { call the mem handling procedures }
  147. case p^.treetype of
  148. simpledisposen:
  149. begin
  150. if ppointerdef(p^.left^.resulttype)^.definition^.needs_inittable then
  151. begin
  152. new(r);
  153. reset_reference(r^);
  154. r^.symbol:=stringdup(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label));
  155. emitpushreferenceaddr(exprasmlist,r^);
  156. { push pointer adress }
  157. case p^.left^.location.loc of
  158. LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,
  159. p^.left^.location.register)));
  160. LOC_REFERENCE:
  161. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  162. end;
  163. stringdispose(r^.symbol);
  164. dispose(r);
  165. emitcall('FPC_FINALIZE',true);
  166. end;
  167. emitcall('FPC_FREEMEM',true);
  168. end;
  169. simplenewn:
  170. begin
  171. emitcall('FPC_GETMEM',true);
  172. if ppointerdef(p^.left^.resulttype)^.definition^.needs_inittable then
  173. begin
  174. new(r);
  175. reset_reference(r^);
  176. r^.symbol:=stringdup(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label));
  177. emitpushreferenceaddr(exprasmlist,r^);
  178. { push pointer adress }
  179. case p^.left^.location.loc of
  180. LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,
  181. p^.left^.location.register)));
  182. LOC_REFERENCE:
  183. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  184. end;
  185. stringdispose(r^.symbol);
  186. dispose(r);
  187. emitcall('FPC_INITIALIZE',true);
  188. end;
  189. end;
  190. end;
  191. popusedregisters(pushed);
  192. { may be load ESI }
  193. maybe_loadesi;
  194. end;
  195. {*****************************************************************************
  196. SecondAddr
  197. *****************************************************************************}
  198. procedure secondaddr(var p : ptree);
  199. begin
  200. secondpass(p^.left);
  201. p^.location.loc:=LOC_REGISTER;
  202. del_reference(p^.left^.location.reference);
  203. p^.location.register:=getregister32;
  204. {@ on a procvar means returning an address to the procedure that
  205. is stored in it.}
  206. { yes but p^.left^.symtableentry can be nil
  207. for example on @self !! }
  208. { symtableentry can be also invalid, if left is no tree node }
  209. if (m_tp_procvar in aktmodeswitches) and
  210. (p^.left^.treetype=loadn) and
  211. assigned(p^.left^.symtableentry) and
  212. (p^.left^.symtableentry^.typ=varsym) and
  213. (pvarsym(p^.left^.symtableentry)^.definition^.deftype=procvardef) then
  214. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  215. newreference(p^.left^.location.reference),
  216. p^.location.register)))
  217. else
  218. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  219. newreference(p^.left^.location.reference),
  220. p^.location.register)));
  221. { for use of other segments }
  222. if p^.left^.location.reference.segment<>R_DEFAULT_SEG then
  223. p^.location.segment:=p^.left^.location.reference.segment;
  224. end;
  225. {*****************************************************************************
  226. SecondDoubleAddr
  227. *****************************************************************************}
  228. procedure seconddoubleaddr(var p : ptree);
  229. begin
  230. secondpass(p^.left);
  231. p^.location.loc:=LOC_REGISTER;
  232. del_reference(p^.left^.location.reference);
  233. p^.location.register:=getregister32;
  234. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  235. newreference(p^.left^.location.reference),
  236. p^.location.register)));
  237. end;
  238. {*****************************************************************************
  239. SecondDeRef
  240. *****************************************************************************}
  241. procedure secondderef(var p : ptree);
  242. var
  243. hr : tregister;
  244. begin
  245. secondpass(p^.left);
  246. clear_reference(p^.location.reference);
  247. case p^.left^.location.loc of
  248. LOC_REGISTER:
  249. p^.location.reference.base:=p^.left^.location.register;
  250. LOC_CREGISTER:
  251. begin
  252. { ... and reserve one for the pointer }
  253. hr:=getregister32;
  254. emit_reg_reg(A_MOV,S_L,p^.left^.location.register,hr);
  255. p^.location.reference.base:=hr;
  256. end;
  257. else
  258. begin
  259. { free register }
  260. del_reference(p^.left^.location.reference);
  261. { ...and reserve one for the pointer }
  262. hr:=getregister32;
  263. exprasmlist^.concat(new(pai386,op_ref_reg(
  264. A_MOV,S_L,newreference(p^.left^.location.reference),
  265. hr)));
  266. p^.location.reference.base:=hr;
  267. end;
  268. end;
  269. if p^.left^.resulttype^.deftype=farpointerdef then
  270. p^.location.reference.segment:=R_FS;
  271. end;
  272. {*****************************************************************************
  273. SecondSubScriptN
  274. *****************************************************************************}
  275. procedure secondsubscriptn(var p : ptree);
  276. var
  277. hr : tregister;
  278. begin
  279. secondpass(p^.left);
  280. if codegenerror then
  281. exit;
  282. { classes must be dereferenced implicit }
  283. if (p^.left^.resulttype^.deftype=objectdef) and
  284. pobjectdef(p^.left^.resulttype)^.isclass then
  285. begin
  286. clear_reference(p^.location.reference);
  287. case p^.left^.location.loc of
  288. LOC_REGISTER:
  289. p^.location.reference.base:=p^.left^.location.register;
  290. LOC_CREGISTER:
  291. begin
  292. { ... and reserve one for the pointer }
  293. hr:=getregister32;
  294. emit_reg_reg(A_MOV,S_L,p^.left^.location.register,hr);
  295. p^.location.reference.base:=hr;
  296. end;
  297. else
  298. begin
  299. { free register }
  300. del_reference(p^.left^.location.reference);
  301. { ... and reserve one for the pointer }
  302. hr:=getregister32;
  303. exprasmlist^.concat(new(pai386,op_ref_reg(
  304. A_MOV,S_L,newreference(p^.left^.location.reference),
  305. hr)));
  306. p^.location.reference.base:=hr;
  307. end;
  308. end;
  309. end
  310. else
  311. set_location(p^.location,p^.left^.location);
  312. inc(p^.location.reference.offset,p^.vs^.address);
  313. end;
  314. {*****************************************************************************
  315. SecondVecN
  316. *****************************************************************************}
  317. procedure secondvecn(var p : ptree);
  318. var
  319. is_pushed : boolean;
  320. ind,hr : tregister;
  321. _p : ptree;
  322. function get_mul_size:longint;
  323. begin
  324. if p^.memindex then
  325. get_mul_size:=1
  326. else
  327. get_mul_size:=p^.resulttype^.size;
  328. end;
  329. procedure calc_emit_mul;
  330. var
  331. l1,l2 : longint;
  332. begin
  333. l1:=get_mul_size;
  334. case l1 of
  335. 1,2,4,8 : p^.location.reference.scalefactor:=l1;
  336. else
  337. begin
  338. if ispowerof2(l1,l2) then
  339. exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,l2,ind)))
  340. else
  341. exprasmlist^.concat(new(pai386,op_const_reg(A_IMUL,S_L,l1,ind)));
  342. end;
  343. end;
  344. end;
  345. var
  346. extraoffset : longint;
  347. t : ptree;
  348. hp : preference;
  349. tai : Pai386;
  350. pushed : tpushed;
  351. begin
  352. secondpass(p^.left);
  353. { we load the array reference to p^.location }
  354. { an ansistring needs to be dereferenced }
  355. if is_ansistring(p^.left^.resulttype) or
  356. is_widestring(p^.left^.resulttype) then
  357. begin
  358. reset_reference(p^.location.reference);
  359. p^.location.loc:=LOC_REFERENCE;
  360. if is_ansistring(p^.left^.resulttype) then
  361. begin
  362. if p^.callunique then
  363. begin
  364. pushusedregisters(pushed,$ff);
  365. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  366. emitcall('FPC_ANSISTR_UNIQUE',true);
  367. maybe_loadesi;
  368. popusedregisters(pushed);
  369. end;
  370. end
  371. else
  372. begin
  373. if p^.callunique then
  374. begin
  375. pushusedregisters(pushed,$ff);
  376. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  377. emitcall('FPC_WIDESTR_UNIQUE',true);
  378. maybe_loadesi;
  379. popusedregisters(pushed);
  380. end;
  381. end;
  382. del_reference(p^.left^.location.reference);
  383. p^.location.reference.base:=getregister32;
  384. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  385. newreference(p^.left^.location.reference),
  386. p^.location.reference.base)));
  387. if is_ansistring(p^.left^.resulttype) then
  388. { in ansistrings S[1] is pchar(S)[0] !! }
  389. dec(p^.location.reference.offset)
  390. else
  391. begin
  392. { in widestrings S[1] is pwchar(S)[0] !! }
  393. dec(p^.location.reference.offset,2);
  394. exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,
  395. 1,p^.location.reference.base)));
  396. end;
  397. { we've also to keep left up-to-date, because it is used }
  398. { if a constant array index occurs, subject to change (FK) }
  399. set_location(p^.left^.location,p^.location);
  400. end
  401. else
  402. set_location(p^.location,p^.left^.location);
  403. { offset can only differ from 0 if arraydef }
  404. if p^.left^.resulttype^.deftype=arraydef then
  405. dec(p^.location.reference.offset,
  406. get_mul_size*parraydef(p^.left^.resulttype)^.lowrange);
  407. if p^.right^.treetype=ordconstn then
  408. begin
  409. { offset can only differ from 0 if arraydef }
  410. if (p^.left^.resulttype^.deftype=arraydef) then
  411. begin
  412. if not(is_open_array(p^.left^.resulttype)) then
  413. begin
  414. if (p^.right^.value>parraydef(p^.left^.resulttype)^.highrange) or
  415. (p^.right^.value<parraydef(p^.left^.resulttype)^.lowrange) then
  416. begin
  417. if (cs_check_range in aktlocalswitches) then
  418. CGMessage(parser_e_range_check_error)
  419. else
  420. CGMessage(parser_w_range_check_error);
  421. end;
  422. dec(p^.left^.location.reference.offset,
  423. get_mul_size*parraydef(p^.left^.resulttype)^.lowrange);
  424. end
  425. else
  426. begin
  427. { range checking for open arrays !!!! }
  428. end;
  429. end
  430. else if (p^.left^.resulttype^.deftype=stringdef) then
  431. begin
  432. if (p^.right^.value=0) and not(is_shortstring(p^.left^.resulttype)) then
  433. CGMessage(cg_e_can_access_element_zero);
  434. case pstringdef(p^.left^.resulttype)^.string_typ of
  435. st_ansistring:
  436. begin
  437. end;
  438. st_shortstring:
  439. begin
  440. end;
  441. st_longstring:
  442. begin
  443. end;
  444. st_widestring:
  445. begin
  446. end;
  447. end;
  448. end;
  449. inc(p^.left^.location.reference.offset,
  450. get_mul_size*p^.right^.value);
  451. if p^.memseg then
  452. p^.left^.location.reference.segment:=R_FS;
  453. p^.left^.resulttype:=p^.resulttype;
  454. disposetree(p^.right);
  455. _p:=p^.left;
  456. putnode(p);
  457. p:=_p;
  458. end
  459. else
  460. begin
  461. { quick hack, to overcome Delphi 2 }
  462. if (cs_regalloc in aktglobalswitches) and
  463. (p^.left^.resulttype^.deftype=arraydef) then
  464. begin
  465. extraoffset:=0;
  466. if (p^.right^.treetype=addn) then
  467. begin
  468. if p^.right^.right^.treetype=ordconstn then
  469. begin
  470. extraoffset:=p^.right^.right^.value;
  471. t:=p^.right^.left;
  472. putnode(p^.right);
  473. putnode(p^.right^.right);
  474. p^.right:=t
  475. end
  476. else if p^.right^.left^.treetype=ordconstn then
  477. begin
  478. extraoffset:=p^.right^.left^.value;
  479. t:=p^.right^.right;
  480. putnode(p^.right);
  481. putnode(p^.right^.left);
  482. p^.right:=t
  483. end;
  484. end
  485. else if (p^.right^.treetype=subn) then
  486. begin
  487. if p^.right^.right^.treetype=ordconstn then
  488. begin
  489. extraoffset:=p^.right^.right^.value;
  490. t:=p^.right^.left;
  491. putnode(p^.right);
  492. putnode(p^.right^.right);
  493. p^.right:=t
  494. end
  495. else if p^.right^.left^.treetype=ordconstn then
  496. begin
  497. extraoffset:=p^.right^.left^.value;
  498. t:=p^.right^.right;
  499. putnode(p^.right);
  500. putnode(p^.right^.left);
  501. p^.right:=t
  502. end;
  503. end;
  504. inc(p^.location.reference.offset,
  505. get_mul_size*extraoffset);
  506. end;
  507. { calculate from left to right }
  508. if (p^.location.loc<>LOC_REFERENCE) and
  509. (p^.location.loc<>LOC_MEM) then
  510. CGMessage(cg_e_illegal_expression);
  511. is_pushed:=maybe_push(p^.right^.registers32,p);
  512. secondpass(p^.right);
  513. if is_pushed then restore(p);
  514. case p^.right^.location.loc of
  515. LOC_REGISTER:
  516. begin
  517. ind:=p^.right^.location.register;
  518. case p^.right^.resulttype^.size of
  519. 1:
  520. begin
  521. hr:=reg8toreg32(ind);
  522. emit_reg_reg(A_MOVZX,S_BL,ind,hr);
  523. ind:=hr;
  524. end;
  525. 2:
  526. begin
  527. hr:=reg16toreg32(ind);
  528. emit_reg_reg(A_MOVZX,S_WL,ind,hr);
  529. ind:=hr;
  530. end;
  531. end;
  532. end;
  533. LOC_CREGISTER:
  534. begin
  535. ind:=getregister32;
  536. case p^.right^.resulttype^.size of
  537. 1:
  538. emit_reg_reg(A_MOVZX,S_BL,p^.right^.location.register,ind);
  539. 2:
  540. emit_reg_reg(A_MOVZX,S_WL,p^.right^.location.register,ind);
  541. 4:
  542. emit_reg_reg(A_MOV,S_L,p^.right^.location.register,ind);
  543. end;
  544. end;
  545. LOC_FLAGS:
  546. begin
  547. ind:=getregister32;
  548. exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.right^.location.resflags],S_B,reg32toreg8(ind))));
  549. emit_reg_reg(A_MOVZX,S_BL,reg32toreg8(ind),ind);
  550. end
  551. else
  552. begin
  553. del_reference(p^.right^.location.reference);
  554. ind:=getregister32;
  555. { Booleans are stored in an 8 bit memory location, so
  556. the use of MOVL is not correct }
  557. case p^.right^.resulttype^.size of
  558. 1:
  559. tai:=new(pai386,op_ref_reg(A_MOVZX,S_BL,newreference(p^.right^.location.reference),ind));
  560. 2:
  561. tai:=new(Pai386,op_ref_reg(A_MOVZX,S_WL,newreference(p^.right^.location.reference),ind));
  562. 4:
  563. tai:=new(Pai386,op_ref_reg(A_MOV,S_L,newreference(p^.right^.location.reference),ind));
  564. end;
  565. exprasmlist^.concat(tai);
  566. end;
  567. end;
  568. { produce possible range check code: }
  569. if cs_check_range in aktlocalswitches then
  570. begin
  571. if p^.left^.resulttype^.deftype=arraydef then
  572. begin
  573. hp:=new_reference(R_NO,0);
  574. parraydef(p^.left^.resulttype)^.genrangecheck;
  575. hp^.symbol:=stringdup(parraydef(p^.left^.resulttype)^.getrangecheckstring);
  576. exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,ind,hp)));
  577. end;
  578. end;
  579. if p^.location.reference.index=R_NO then
  580. begin
  581. p^.location.reference.index:=ind;
  582. calc_emit_mul;
  583. end
  584. else
  585. begin
  586. if p^.location.reference.base=R_NO then
  587. begin
  588. case p^.location.reference.scalefactor of
  589. 2 : exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,1,p^.location.reference.index)));
  590. 4 : exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,2,p^.location.reference.index)));
  591. 8 : exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,3,p^.location.reference.index)));
  592. end;
  593. calc_emit_mul;
  594. p^.location.reference.base:=p^.location.reference.index;
  595. p^.location.reference.index:=ind;
  596. end
  597. else
  598. begin
  599. exprasmlist^.concat(new(pai386,op_ref_reg(
  600. A_LEA,S_L,newreference(p^.location.reference),
  601. p^.location.reference.index)));
  602. ungetregister32(p^.location.reference.base);
  603. { the symbol offset is loaded, }
  604. { so release the symbol name and set symbol }
  605. { to nil }
  606. stringdispose(p^.location.reference.symbol);
  607. p^.location.reference.offset:=0;
  608. calc_emit_mul;
  609. p^.location.reference.base:=p^.location.reference.index;
  610. p^.location.reference.index:=ind;
  611. end;
  612. end;
  613. if p^.memseg then
  614. p^.location.reference.segment:=R_FS;
  615. end;
  616. end;
  617. {*****************************************************************************
  618. SecondSelfN
  619. *****************************************************************************}
  620. procedure secondselfn(var p : ptree);
  621. begin
  622. clear_reference(p^.location.reference);
  623. if (p^.resulttype^.deftype=classrefdef) or
  624. ((p^.resulttype^.deftype=objectdef)
  625. and pobjectdef(p^.resulttype)^.isclass
  626. ) then
  627. p^.location.register:=R_ESI
  628. else
  629. p^.location.reference.base:=R_ESI;
  630. end;
  631. {*****************************************************************************
  632. SecondWithN
  633. *****************************************************************************}
  634. procedure secondwith(var p : ptree);
  635. var
  636. ref : treference;
  637. symtable : psymtable;
  638. i : longint;
  639. load : boolean;
  640. begin
  641. if assigned(p^.left) then
  642. begin
  643. secondpass(p^.left);
  644. load:=true;
  645. if p^.left^.location.reference.segment<>R_DEFAULT_SEG then
  646. message(parser_e_no_with_for_variable_in_other_segments);
  647. ref.symbol:=nil;
  648. gettempofsizereference(4,ref);
  649. if (p^.left^.treetype=loadn) and
  650. (p^.left^.symtable=aktprocsym^.definition^.localst) then
  651. begin
  652. { for local class just use the local storage }
  653. ungetiftemp(ref);
  654. new(p^.pref);
  655. p^.pref^:=p^.left^.location.reference;
  656. { don't discard symbol if in main procedure }
  657. p^.left^.location.reference.symbol:=nil;
  658. load:=false;
  659. end
  660. else if (p^.left^.resulttype^.deftype=objectdef) and
  661. pobjectdef(p^.left^.resulttype)^.isclass then
  662. begin
  663. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  664. newreference(p^.left^.location.reference),R_EDI)))
  665. end
  666. else
  667. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  668. newreference(p^.left^.location.reference),R_EDI)));
  669. if load then
  670. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
  671. R_EDI,newreference(ref))));
  672. del_reference(p^.left^.location.reference);
  673. { the offset relative to (%ebp) is only needed here! }
  674. symtable:=p^.withsymtable;
  675. for i:=1 to p^.tablecount do
  676. begin
  677. symtable^.datasize:=ref.offset;
  678. symtable:=symtable^.next;
  679. end;
  680. { p^.right can be optimize out !!! }
  681. if p^.right<>nil then
  682. secondpass(p^.right);
  683. { clear some stuff }
  684. if assigned(p^.pref) then
  685. dispose(p^.pref);
  686. if load then
  687. ungetiftemp(ref);
  688. end;
  689. end;
  690. end.
  691. {
  692. $Log$
  693. Revision 1.25 1999-01-21 16:40:52 pierre
  694. * fix for constructor inside with statements
  695. Revision 1.24 1999/01/19 12:05:27 pierre
  696. * bug with @procvar=procvar fiwed
  697. Revision 1.23 1998/12/30 22:15:45 peter
  698. + farpointer type
  699. * absolutesym now also stores if its far
  700. Revision 1.22 1998/12/11 00:02:55 peter
  701. + globtype,tokens,version unit splitted from globals
  702. Revision 1.21 1998/12/10 09:47:18 florian
  703. + basic operations with int64/qord (compiler with -dint64)
  704. + rtti of enumerations extended: names are now written
  705. Revision 1.20 1998/11/25 19:12:54 pierre
  706. * var:=new(pointer_type) support added
  707. Revision 1.19 1998/11/20 15:35:55 florian
  708. * problems with rtti fixed, hope it works
  709. Revision 1.18 1998/11/17 00:36:40 peter
  710. * more ansistring fixes
  711. Revision 1.17 1998/11/16 15:35:09 pierre
  712. * added error for with if different segment
  713. Revision 1.16 1998/10/21 11:44:42 florian
  714. + check for access to index 0 of long/wide/ansi strings added,
  715. gives now an error
  716. * problem with access to contant index of ansistrings fixed
  717. Revision 1.15 1998/10/12 09:49:53 florian
  718. + support of <procedure var type>:=<pointer> in delphi mode added
  719. Revision 1.14 1998/10/02 07:20:37 florian
  720. * range checking in units doesn't work if the units are smartlinked, fixed
  721. Revision 1.13 1998/09/27 10:16:23 florian
  722. * type casts pchar<->ansistring fixed
  723. * ansistring[..] calls does now an unique call
  724. Revision 1.12 1998/09/23 15:46:36 florian
  725. * problem with with and classes fixed
  726. Revision 1.11 1998/09/17 09:42:18 peter
  727. + pass_2 for cg386
  728. * Message() -> CGMessage() for pass_1/pass_2
  729. Revision 1.10 1998/09/14 10:43:52 peter
  730. * all internal RTL functions start with FPC_
  731. Revision 1.9 1998/09/03 16:03:15 florian
  732. + rtti generation
  733. * init table generation changed
  734. Revision 1.8 1998/08/23 21:04:34 florian
  735. + rtti generation for classes added
  736. + new/dispose do now also a call to INITIALIZE/FINALIZE, if necessaray
  737. Revision 1.7 1998/08/20 11:27:40 michael
  738. * Applied Peters Fix
  739. Revision 1.6 1998/08/10 14:49:49 peter
  740. + localswitches, moduleswitches, globalswitches splitting
  741. Revision 1.5 1998/07/26 21:58:58 florian
  742. + better support for switch $H
  743. + index access to ansi strings added
  744. + assigment of data (records/arrays) containing ansi strings
  745. Revision 1.4 1998/07/24 22:16:55 florian
  746. * internal error 10 together with array access fixed. I hope
  747. that's the final fix.
  748. Revision 1.3 1998/06/25 08:48:09 florian
  749. * first version of rtti support
  750. Revision 1.2 1998/06/08 13:13:35 pierre
  751. + temporary variables now in temp_gen.pas unit
  752. because it is processor independent
  753. * mppc68k.bat modified to undefine i386 and support_mmx
  754. (which are defaults for i386)
  755. Revision 1.1 1998/06/05 17:44:13 peter
  756. * splitted cgi386
  757. }