cg386mem.pas 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827
  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 (p^.left^.treetype=loadn) and
  210. assigned(p^.left^.symtableentry) and
  211. (p^.left^.symtableentry^.typ=varsym) and
  212. (pvarsym(p^.left^.symtableentry)^.definition^.deftype=procvardef) then
  213. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  214. newreference(p^.left^.location.reference),
  215. p^.location.register)))
  216. else
  217. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  218. newreference(p^.left^.location.reference),
  219. p^.location.register)));
  220. { for use of other segments }
  221. if p^.left^.location.reference.segment<>R_DEFAULT_SEG then
  222. p^.location.segment:=p^.left^.location.reference.segment;
  223. end;
  224. {*****************************************************************************
  225. SecondDoubleAddr
  226. *****************************************************************************}
  227. procedure seconddoubleaddr(var p : ptree);
  228. begin
  229. secondpass(p^.left);
  230. p^.location.loc:=LOC_REGISTER;
  231. del_reference(p^.left^.location.reference);
  232. p^.location.register:=getregister32;
  233. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  234. newreference(p^.left^.location.reference),
  235. p^.location.register)));
  236. end;
  237. {*****************************************************************************
  238. SecondDeRef
  239. *****************************************************************************}
  240. procedure secondderef(var p : ptree);
  241. var
  242. hr : tregister;
  243. begin
  244. secondpass(p^.left);
  245. clear_reference(p^.location.reference);
  246. case p^.left^.location.loc of
  247. LOC_REGISTER:
  248. p^.location.reference.base:=p^.left^.location.register;
  249. LOC_CREGISTER:
  250. begin
  251. { ... and reserve one for the pointer }
  252. hr:=getregister32;
  253. emit_reg_reg(A_MOV,S_L,p^.left^.location.register,hr);
  254. p^.location.reference.base:=hr;
  255. end;
  256. else
  257. begin
  258. { free register }
  259. del_reference(p^.left^.location.reference);
  260. { ...and reserve one for the pointer }
  261. hr:=getregister32;
  262. exprasmlist^.concat(new(pai386,op_ref_reg(
  263. A_MOV,S_L,newreference(p^.left^.location.reference),
  264. hr)));
  265. p^.location.reference.base:=hr;
  266. end;
  267. end;
  268. end;
  269. {*****************************************************************************
  270. SecondSubScriptN
  271. *****************************************************************************}
  272. procedure secondsubscriptn(var p : ptree);
  273. var
  274. hr : tregister;
  275. begin
  276. secondpass(p^.left);
  277. if codegenerror then
  278. exit;
  279. { classes must be dereferenced implicit }
  280. if (p^.left^.resulttype^.deftype=objectdef) and
  281. pobjectdef(p^.left^.resulttype)^.isclass then
  282. begin
  283. clear_reference(p^.location.reference);
  284. case p^.left^.location.loc of
  285. LOC_REGISTER:
  286. p^.location.reference.base:=p^.left^.location.register;
  287. LOC_CREGISTER:
  288. begin
  289. { ... and reserve one for the pointer }
  290. hr:=getregister32;
  291. emit_reg_reg(A_MOV,S_L,p^.left^.location.register,hr);
  292. p^.location.reference.base:=hr;
  293. end;
  294. else
  295. begin
  296. { free register }
  297. del_reference(p^.left^.location.reference);
  298. { ... and reserve one for the pointer }
  299. hr:=getregister32;
  300. exprasmlist^.concat(new(pai386,op_ref_reg(
  301. A_MOV,S_L,newreference(p^.left^.location.reference),
  302. hr)));
  303. p^.location.reference.base:=hr;
  304. end;
  305. end;
  306. end
  307. else
  308. set_location(p^.location,p^.left^.location);
  309. inc(p^.location.reference.offset,p^.vs^.address);
  310. end;
  311. {*****************************************************************************
  312. SecondVecN
  313. *****************************************************************************}
  314. procedure secondvecn(var p : ptree);
  315. var
  316. is_pushed : boolean;
  317. ind,hr : tregister;
  318. _p : ptree;
  319. function get_mul_size:longint;
  320. begin
  321. if p^.memindex then
  322. get_mul_size:=1
  323. else
  324. get_mul_size:=p^.resulttype^.size;
  325. end;
  326. procedure calc_emit_mul;
  327. var
  328. l1,l2 : longint;
  329. begin
  330. l1:=get_mul_size;
  331. case l1 of
  332. 1,2,4,8 : p^.location.reference.scalefactor:=l1;
  333. else
  334. begin
  335. if ispowerof2(l1,l2) then
  336. exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,l2,ind)))
  337. else
  338. exprasmlist^.concat(new(pai386,op_const_reg(A_IMUL,S_L,l1,ind)));
  339. end;
  340. end;
  341. end;
  342. var
  343. extraoffset : longint;
  344. t : ptree;
  345. hp : preference;
  346. tai : Pai386;
  347. pushed : tpushed;
  348. begin
  349. secondpass(p^.left);
  350. { we load the array reference to p^.location }
  351. { an ansistring needs to be dereferenced }
  352. if is_ansistring(p^.left^.resulttype) or
  353. is_widestring(p^.left^.resulttype) then
  354. begin
  355. reset_reference(p^.location.reference);
  356. p^.location.loc:=LOC_REFERENCE;
  357. if is_ansistring(p^.left^.resulttype) then
  358. begin
  359. if p^.callunique then
  360. begin
  361. pushusedregisters(pushed,$ff);
  362. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  363. emitcall('FPC_ANSISTR_UNIQUE',true);
  364. maybe_loadesi;
  365. popusedregisters(pushed);
  366. end;
  367. end
  368. else
  369. begin
  370. if p^.callunique then
  371. begin
  372. pushusedregisters(pushed,$ff);
  373. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  374. emitcall('FPC_WIDESTR_UNIQUE',true);
  375. maybe_loadesi;
  376. popusedregisters(pushed);
  377. end;
  378. end;
  379. del_reference(p^.left^.location.reference);
  380. p^.location.reference.base:=getregister32;
  381. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  382. newreference(p^.left^.location.reference),
  383. p^.location.reference.base)));
  384. if is_ansistring(p^.left^.resulttype) then
  385. { in ansistrings S[1] is pchar(S)[0] !! }
  386. dec(p^.location.reference.offset)
  387. else
  388. begin
  389. { in widestrings S[1] is pwchar(S)[0] !! }
  390. dec(p^.location.reference.offset,2);
  391. exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,
  392. 1,p^.location.reference.base)));
  393. end;
  394. { we've also to keep left up-to-date, because it is used }
  395. { if a constant array index occurs, subject to change (FK) }
  396. set_location(p^.left^.location,p^.location);
  397. end
  398. else
  399. set_location(p^.location,p^.left^.location);
  400. { offset can only differ from 0 if arraydef }
  401. if p^.left^.resulttype^.deftype=arraydef then
  402. dec(p^.location.reference.offset,
  403. get_mul_size*parraydef(p^.left^.resulttype)^.lowrange);
  404. if p^.right^.treetype=ordconstn then
  405. begin
  406. { offset can only differ from 0 if arraydef }
  407. if (p^.left^.resulttype^.deftype=arraydef) then
  408. begin
  409. if not(is_open_array(p^.left^.resulttype)) then
  410. begin
  411. if (p^.right^.value>parraydef(p^.left^.resulttype)^.highrange) or
  412. (p^.right^.value<parraydef(p^.left^.resulttype)^.lowrange) then
  413. begin
  414. if (cs_check_range in aktlocalswitches) then
  415. CGMessage(parser_e_range_check_error)
  416. else
  417. CGMessage(parser_w_range_check_error);
  418. end;
  419. dec(p^.left^.location.reference.offset,
  420. get_mul_size*parraydef(p^.left^.resulttype)^.lowrange);
  421. end
  422. else
  423. begin
  424. { range checking for open arrays !!!! }
  425. end;
  426. end
  427. else if (p^.left^.resulttype^.deftype=stringdef) then
  428. begin
  429. if (p^.right^.value=0) and not(is_shortstring(p^.left^.resulttype)) then
  430. CGMessage(cg_e_can_access_element_zero);
  431. case pstringdef(p^.left^.resulttype)^.string_typ of
  432. st_ansistring:
  433. begin
  434. end;
  435. st_shortstring:
  436. begin
  437. end;
  438. st_longstring:
  439. begin
  440. end;
  441. st_widestring:
  442. begin
  443. end;
  444. end;
  445. end;
  446. inc(p^.left^.location.reference.offset,
  447. get_mul_size*p^.right^.value);
  448. if p^.memseg then
  449. p^.left^.location.reference.segment:=R_FS;
  450. p^.left^.resulttype:=p^.resulttype;
  451. disposetree(p^.right);
  452. _p:=p^.left;
  453. putnode(p);
  454. p:=_p;
  455. end
  456. else
  457. begin
  458. { quick hack, to overcome Delphi 2 }
  459. if (cs_regalloc in aktglobalswitches) and
  460. (p^.left^.resulttype^.deftype=arraydef) then
  461. begin
  462. extraoffset:=0;
  463. if (p^.right^.treetype=addn) then
  464. begin
  465. if p^.right^.right^.treetype=ordconstn then
  466. begin
  467. extraoffset:=p^.right^.right^.value;
  468. t:=p^.right^.left;
  469. putnode(p^.right);
  470. putnode(p^.right^.right);
  471. p^.right:=t
  472. end
  473. else if p^.right^.left^.treetype=ordconstn then
  474. begin
  475. extraoffset:=p^.right^.left^.value;
  476. t:=p^.right^.right;
  477. putnode(p^.right);
  478. putnode(p^.right^.left);
  479. p^.right:=t
  480. end;
  481. end
  482. else if (p^.right^.treetype=subn) then
  483. begin
  484. if p^.right^.right^.treetype=ordconstn then
  485. begin
  486. extraoffset:=p^.right^.right^.value;
  487. t:=p^.right^.left;
  488. putnode(p^.right);
  489. putnode(p^.right^.right);
  490. p^.right:=t
  491. end
  492. else if p^.right^.left^.treetype=ordconstn then
  493. begin
  494. extraoffset:=p^.right^.left^.value;
  495. t:=p^.right^.right;
  496. putnode(p^.right);
  497. putnode(p^.right^.left);
  498. p^.right:=t
  499. end;
  500. end;
  501. inc(p^.location.reference.offset,
  502. get_mul_size*extraoffset);
  503. end;
  504. { calculate from left to right }
  505. if (p^.location.loc<>LOC_REFERENCE) and
  506. (p^.location.loc<>LOC_MEM) then
  507. CGMessage(cg_e_illegal_expression);
  508. is_pushed:=maybe_push(p^.right^.registers32,p);
  509. secondpass(p^.right);
  510. if is_pushed then restore(p);
  511. case p^.right^.location.loc of
  512. LOC_REGISTER:
  513. begin
  514. ind:=p^.right^.location.register;
  515. case p^.right^.resulttype^.size of
  516. 1:
  517. begin
  518. hr:=reg8toreg32(ind);
  519. emit_reg_reg(A_MOVZX,S_BL,ind,hr);
  520. ind:=hr;
  521. end;
  522. 2:
  523. begin
  524. hr:=reg16toreg32(ind);
  525. emit_reg_reg(A_MOVZX,S_WL,ind,hr);
  526. ind:=hr;
  527. end;
  528. end;
  529. end;
  530. LOC_CREGISTER:
  531. begin
  532. ind:=getregister32;
  533. case p^.right^.resulttype^.size of
  534. 1:
  535. emit_reg_reg(A_MOVZX,S_BL,p^.right^.location.register,ind);
  536. 2:
  537. emit_reg_reg(A_MOVZX,S_WL,p^.right^.location.register,ind);
  538. 4:
  539. emit_reg_reg(A_MOV,S_L,p^.right^.location.register,ind);
  540. end;
  541. end;
  542. LOC_FLAGS:
  543. begin
  544. ind:=getregister32;
  545. exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.right^.location.resflags],S_B,reg32toreg8(ind))));
  546. emit_reg_reg(A_MOVZX,S_BL,reg32toreg8(ind),ind);
  547. end
  548. else
  549. begin
  550. del_reference(p^.right^.location.reference);
  551. ind:=getregister32;
  552. { Booleans are stored in an 8 bit memory location, so
  553. the use of MOVL is not correct }
  554. case p^.right^.resulttype^.size of
  555. 1:
  556. tai:=new(pai386,op_ref_reg(A_MOVZX,S_BL,newreference(p^.right^.location.reference),ind));
  557. 2:
  558. tai:=new(Pai386,op_ref_reg(A_MOVZX,S_WL,newreference(p^.right^.location.reference),ind));
  559. 4:
  560. tai:=new(Pai386,op_ref_reg(A_MOV,S_L,newreference(p^.right^.location.reference),ind));
  561. end;
  562. exprasmlist^.concat(tai);
  563. end;
  564. end;
  565. { produce possible range check code: }
  566. if cs_check_range in aktlocalswitches then
  567. begin
  568. if p^.left^.resulttype^.deftype=arraydef then
  569. begin
  570. hp:=new_reference(R_NO,0);
  571. parraydef(p^.left^.resulttype)^.genrangecheck;
  572. hp^.symbol:=stringdup(parraydef(p^.left^.resulttype)^.getrangecheckstring);
  573. exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,ind,hp)));
  574. end;
  575. end;
  576. if p^.location.reference.index=R_NO then
  577. begin
  578. p^.location.reference.index:=ind;
  579. calc_emit_mul;
  580. end
  581. else
  582. begin
  583. if p^.location.reference.base=R_NO then
  584. begin
  585. case p^.location.reference.scalefactor of
  586. 2 : exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,1,p^.location.reference.index)));
  587. 4 : exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,2,p^.location.reference.index)));
  588. 8 : exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,3,p^.location.reference.index)));
  589. end;
  590. calc_emit_mul;
  591. p^.location.reference.base:=p^.location.reference.index;
  592. p^.location.reference.index:=ind;
  593. end
  594. else
  595. begin
  596. exprasmlist^.concat(new(pai386,op_ref_reg(
  597. A_LEA,S_L,newreference(p^.location.reference),
  598. p^.location.reference.index)));
  599. ungetregister32(p^.location.reference.base);
  600. { the symbol offset is loaded, }
  601. { so release the symbol name and set symbol }
  602. { to nil }
  603. stringdispose(p^.location.reference.symbol);
  604. p^.location.reference.offset:=0;
  605. calc_emit_mul;
  606. p^.location.reference.base:=p^.location.reference.index;
  607. p^.location.reference.index:=ind;
  608. end;
  609. end;
  610. if p^.memseg then
  611. p^.location.reference.segment:=R_FS;
  612. end;
  613. end;
  614. {*****************************************************************************
  615. SecondSelfN
  616. *****************************************************************************}
  617. procedure secondselfn(var p : ptree);
  618. begin
  619. clear_reference(p^.location.reference);
  620. if (p^.resulttype^.deftype=classrefdef) or
  621. ((p^.resulttype^.deftype=objectdef)
  622. and pobjectdef(p^.resulttype)^.isclass
  623. ) then
  624. p^.location.register:=R_ESI
  625. else
  626. p^.location.reference.base:=R_ESI;
  627. end;
  628. {*****************************************************************************
  629. SecondWithN
  630. *****************************************************************************}
  631. procedure secondwith(var p : ptree);
  632. var
  633. ref : treference;
  634. symtable : psymtable;
  635. i : longint;
  636. begin
  637. if assigned(p^.left) then
  638. begin
  639. secondpass(p^.left);
  640. if p^.left^.location.reference.segment<>R_DEFAULT_SEG then
  641. message(parser_e_no_with_for_variable_in_other_segments);
  642. ref.symbol:=nil;
  643. gettempofsizereference(4,ref);
  644. if (p^.left^.resulttype^.deftype=objectdef) and
  645. pobjectdef(p^.left^.resulttype)^.isclass then
  646. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  647. newreference(p^.left^.location.reference),R_EDI)))
  648. else
  649. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  650. newreference(p^.left^.location.reference),R_EDI)));
  651. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
  652. R_EDI,newreference(ref))));
  653. del_reference(p^.left^.location.reference);
  654. { the offset relative to (%ebp) is only needed here! }
  655. symtable:=p^.withsymtable;
  656. for i:=1 to p^.tablecount do
  657. begin
  658. {$ifdef WITHTEST}
  659. {$else WITHTEST}
  660. symtable^.datasize:=ref.offset;
  661. {$endif WITHTEST}
  662. symtable:=symtable^.next;
  663. end;
  664. { p^.right can be optimize out !!! }
  665. if p^.right<>nil then
  666. secondpass(p^.right);
  667. { clear some stuff }
  668. ungetiftemp(ref);
  669. end;
  670. end;
  671. end.
  672. {
  673. $Log$
  674. Revision 1.22 1998-12-11 00:02:55 peter
  675. + globtype,tokens,version unit splitted from globals
  676. Revision 1.21 1998/12/10 09:47:18 florian
  677. + basic operations with int64/qord (compiler with -dint64)
  678. + rtti of enumerations extended: names are now written
  679. Revision 1.20 1998/11/25 19:12:54 pierre
  680. * var:=new(pointer_type) support added
  681. Revision 1.19 1998/11/20 15:35:55 florian
  682. * problems with rtti fixed, hope it works
  683. Revision 1.18 1998/11/17 00:36:40 peter
  684. * more ansistring fixes
  685. Revision 1.17 1998/11/16 15:35:09 pierre
  686. * added error for with if different segment
  687. Revision 1.16 1998/10/21 11:44:42 florian
  688. + check for access to index 0 of long/wide/ansi strings added,
  689. gives now an error
  690. * problem with access to contant index of ansistrings fixed
  691. Revision 1.15 1998/10/12 09:49:53 florian
  692. + support of <procedure var type>:=<pointer> in delphi mode added
  693. Revision 1.14 1998/10/02 07:20:37 florian
  694. * range checking in units doesn't work if the units are smartlinked, fixed
  695. Revision 1.13 1998/09/27 10:16:23 florian
  696. * type casts pchar<->ansistring fixed
  697. * ansistring[..] calls does now an unique call
  698. Revision 1.12 1998/09/23 15:46:36 florian
  699. * problem with with and classes fixed
  700. Revision 1.11 1998/09/17 09:42:18 peter
  701. + pass_2 for cg386
  702. * Message() -> CGMessage() for pass_1/pass_2
  703. Revision 1.10 1998/09/14 10:43:52 peter
  704. * all internal RTL functions start with FPC_
  705. Revision 1.9 1998/09/03 16:03:15 florian
  706. + rtti generation
  707. * init table generation changed
  708. Revision 1.8 1998/08/23 21:04:34 florian
  709. + rtti generation for classes added
  710. + new/dispose do now also a call to INITIALIZE/FINALIZE, if necessaray
  711. Revision 1.7 1998/08/20 11:27:40 michael
  712. * Applied Peters Fix
  713. Revision 1.6 1998/08/10 14:49:49 peter
  714. + localswitches, moduleswitches, globalswitches splitting
  715. Revision 1.5 1998/07/26 21:58:58 florian
  716. + better support for switch $H
  717. + index access to ansi strings added
  718. + assigment of data (records/arrays) containing ansi strings
  719. Revision 1.4 1998/07/24 22:16:55 florian
  720. * internal error 10 together with array access fixed. I hope
  721. that's the final fix.
  722. Revision 1.3 1998/06/25 08:48:09 florian
  723. * first version of rtti support
  724. Revision 1.2 1998/06/08 13:13:35 pierre
  725. + temporary variables now in temp_gen.pas unit
  726. because it is processor independent
  727. * mppc68k.bat modified to undefine i386 and support_mmx
  728. (which are defaults for i386)
  729. Revision 1.1 1998/06/05 17:44:13 peter
  730. * splitted cgi386
  731. }