cg386mem.pas 32 KB

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