cg386mem.pas 31 KB

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