cg68kmem.pas 30 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 by Florian Klaempfl
  4. Generate m68k 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 cg68kmem;
  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. m68k,cga68k,tgen68k;
  40. {*****************************************************************************
  41. SecondLoadVMT
  42. *****************************************************************************}
  43. procedure secondloadvmt(var p : ptree);
  44. begin
  45. p^.location.loc:=LOC_REGISTER;
  46. p^.location.register:=getregister32;
  47. exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_MOVE,
  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. {!!!!!!!}
  80. (* if ppointerdef(p^.resulttype)^.definition^.needs_inittable then
  81. begin
  82. new(r);
  83. reset_reference(r^);
  84. r^.symbol:=stringdup(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label));
  85. emitpushreferenceaddr(exprasmlist,r^);
  86. { push pointer adress }
  87. emitpushreferenceaddr(exprasmlist,p^.location.reference);
  88. stringdispose(r^.symbol);
  89. dispose(r);
  90. emitcall('FPC_INITIALIZE',true);
  91. end; *)
  92. popusedregisters(pushed);
  93. { may be load ESI }
  94. maybe_loada5;
  95. end;
  96. if codegenerror then
  97. exit;
  98. end;
  99. {*****************************************************************************
  100. SecondDisposeN
  101. *****************************************************************************}
  102. procedure secondhdisposen(var p : ptree);
  103. begin
  104. secondpass(p^.left);
  105. if codegenerror then
  106. exit;
  107. clear_reference(p^.location.reference);
  108. case p^.left^.location.loc of
  109. LOC_REGISTER,
  110. LOC_CREGISTER : begin
  111. p^.location.reference.base:=getaddressreg;
  112. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
  113. p^.left^.location.register,
  114. p^.location.reference.base)));
  115. end;
  116. LOC_MEM,LOC_REFERENCE :
  117. begin
  118. del_reference(p^.left^.location.reference);
  119. p^.location.reference.base:=getaddressreg;
  120. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
  121. p^.location.reference.base)));
  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,$ffff);
  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(pai68k,op_reg_reg(A_MOVE,S_L,
  142. p^.left^.location.register,R_SPPUSH)));
  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. {!!!!!!!}
  153. (* new(r);
  154. reset_reference(r^);
  155. r^.symbol:=stringdup(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_rtti_label));
  156. emitpushreferenceaddr(exprasmlist,r^);
  157. { push pointer adress }
  158. case p^.left^.location.loc of
  159. LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,
  160. p^.left^.location.register)));
  161. LOC_REFERENCE:
  162. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  163. end;
  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. {!!!!!!!}
  174. (* new(r);
  175. reset_reference(r^);
  176. r^.symbol:=stringdup(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_rtti_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. emitcall('FPC_INITIALIZE',true); *)
  186. end;
  187. end;
  188. end;
  189. popusedregisters(pushed);
  190. { may be load ESI }
  191. maybe_loada5;
  192. end;
  193. {*****************************************************************************
  194. SecondAddr
  195. *****************************************************************************}
  196. procedure secondaddr(var p : ptree);
  197. begin
  198. secondpass(p^.left);
  199. p^.location.loc:=LOC_REGISTER;
  200. p^.location.register:=getregister32;
  201. {@ on a procvar means returning an address to the procedure that
  202. is stored in it.}
  203. { yes but p^.left^.symtableentry can be nil
  204. for example on @self !! }
  205. { symtableentry can be also invalid, if left is no tree node }
  206. if (p^.left^.treetype=loadn) and
  207. assigned(p^.left^.symtableentry) and
  208. (p^.left^.symtableentry^.typ=varsym) and
  209. (Pvarsym(p^.left^.symtableentry)^.definition^.deftype=
  210. procvardef) then
  211. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  212. newreference(p^.left^.location.reference),
  213. p^.location.register)))
  214. else
  215. begin
  216. exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
  217. newreference(p^.left^.location.reference),R_A0)));
  218. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
  219. R_A0,p^.location.register)));
  220. end;
  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. }
  225. del_reference(p^.left^.location.reference);
  226. end;
  227. {*****************************************************************************
  228. SecondDoubleAddr
  229. *****************************************************************************}
  230. procedure seconddoubleaddr(var p : ptree);
  231. begin
  232. secondpass(p^.left);
  233. p^.location.loc:=LOC_REGISTER;
  234. del_reference(p^.left^.location.reference);
  235. p^.location.register:=getregister32;
  236. exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
  237. newreference(p^.left^.location.reference),R_A0)));
  238. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
  239. R_A0,p^.location.register)));
  240. end;
  241. {*****************************************************************************
  242. SecondDeRef
  243. *****************************************************************************}
  244. procedure secondderef(var p : ptree);
  245. var
  246. hr : tregister;
  247. begin
  248. secondpass(p^.left);
  249. clear_reference(p^.location.reference);
  250. case p^.left^.location.loc of
  251. LOC_REGISTER : Begin
  252. hr := getaddressreg;
  253. emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hr);
  254. p^.location.reference.base:=hr;
  255. ungetregister(p^.left^.location.register);
  256. end;
  257. LOC_CREGISTER : begin
  258. { ... and reserve one for the pointer }
  259. hr:=getaddressreg;
  260. emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hr);
  261. p^.location.reference.base:=hr;
  262. { LOC_REGISTER indicates that this is a
  263. variable register which should not be freed. }
  264. { ungetregister(p^.left^.location.register); }
  265. end;
  266. else
  267. begin
  268. { free register }
  269. del_reference(p^.left^.location.reference);
  270. { ...and reserve one for the pointer }
  271. hr:=getaddressreg;
  272. exprasmlist^.concat(new(pai68k,op_ref_reg(
  273. A_MOVE,S_L,newreference(p^.left^.location.reference),
  274. hr)));
  275. p^.location.reference.base:=hr;
  276. end;
  277. end;
  278. end;
  279. {*****************************************************************************
  280. SecondSubScriptN
  281. *****************************************************************************}
  282. procedure secondsubscriptn(var p : ptree);
  283. var
  284. hr: tregister;
  285. begin
  286. secondpass(p^.left);
  287. if codegenerror then
  288. exit;
  289. { classes must be dereferenced implicit }
  290. if (p^.left^.resulttype^.deftype=objectdef) and
  291. pobjectdef(p^.left^.resulttype)^.isclass then
  292. begin
  293. clear_reference(p^.location.reference);
  294. case p^.left^.location.loc of
  295. LOC_REGISTER:
  296. begin
  297. { move it to an address register...}
  298. hr:=getaddressreg;
  299. emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hr);
  300. p^.location.reference.base:=hr;
  301. { free register }
  302. ungetregister(p^.left^.location.register);
  303. end;
  304. LOC_CREGISTER:
  305. begin
  306. { ... and reserve one for the pointer }
  307. hr:=getaddressreg;
  308. emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hr);
  309. p^.location.reference.base:=hr;
  310. end;
  311. else
  312. begin
  313. { free register }
  314. del_reference(p^.left^.location.reference);
  315. { ... and reserve one for the pointer }
  316. hr:=getaddressreg;
  317. exprasmlist^.concat(new(pai68k,op_ref_reg(
  318. A_MOVE,S_L,newreference(p^.left^.location.reference),
  319. hr)));
  320. p^.location.reference.base:=hr;
  321. end;
  322. end;
  323. end
  324. else
  325. set_location(p^.location,p^.left^.location);
  326. inc(p^.location.reference.offset,p^.vs^.address);
  327. end;
  328. {*****************************************************************************
  329. SecondVecN
  330. *****************************************************************************}
  331. { used D0, D1 as scratch (ok) }
  332. { arrays ... }
  333. { Sets up the array and string }
  334. { references . }
  335. procedure secondvecn(var p : ptree);
  336. var
  337. pushed : boolean;
  338. ind : tregister;
  339. _p : ptree;
  340. procedure calc_emit_mul;
  341. var
  342. l1,l2 : longint;
  343. begin
  344. l1:=p^.resulttype^.size;
  345. case l1 of
  346. 1 : p^.location.reference.scalefactor:=l1;
  347. 2 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,1,ind)));
  348. 4 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,2,ind)));
  349. 8 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,3,ind)));
  350. else
  351. begin
  352. if ispowerof2(l1,l2) then
  353. exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,l2,ind)))
  354. else
  355. begin
  356. { use normal MC68000 signed multiply }
  357. if (l1 >= -32768) and (l1 <= 32767) then
  358. exprasmlist^.concat(new(pai68k,op_const_reg(A_MULS,S_W,l1,ind)))
  359. else
  360. { use long MC68020 long multiply }
  361. if (aktoptprocessor = MC68020) then
  362. exprasmlist^.concat(new(pai68k,op_const_reg(A_MULS,S_L,l1,ind)))
  363. else
  364. { MC68000 long multiply }
  365. begin
  366. exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,l1,R_D0)));
  367. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,ind,R_D1)));
  368. emitcall('FPC_LONGMUL',true);
  369. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,ind)));
  370. end;
  371. end;
  372. end; { else case }
  373. end; { end case }
  374. end; { calc_emit_mul }
  375. var
  376. extraoffset : longint;
  377. t : ptree;
  378. hp : preference;
  379. tai:pai68k;
  380. reg: tregister;
  381. begin
  382. secondpass(p^.left);
  383. { RESULT IS IN p^.location.reference }
  384. set_location(p^.location,p^.left^.location);
  385. { offset can only differ from 0 if arraydef }
  386. if p^.left^.resulttype^.deftype=arraydef then
  387. dec(p^.location.reference.offset,
  388. p^.resulttype^.size*
  389. parraydef(p^.left^.resulttype)^.lowrange);
  390. if p^.right^.treetype=ordconstn then
  391. begin
  392. { offset can only differ from 0 if arraydef }
  393. if (p^.left^.resulttype^.deftype=arraydef) then
  394. begin
  395. if not(is_open_array(p^.left^.resulttype)) then
  396. begin
  397. if (p^.right^.value>parraydef(p^.left^.resulttype)^.highrange) or
  398. (p^.right^.value<parraydef(p^.left^.resulttype)^.lowrange) then
  399. CGMessage(parser_e_range_check_error);
  400. dec(p^.left^.location.reference.offset,
  401. p^.resulttype^.size*parraydef(p^.left^.resulttype)^.lowrange);
  402. end
  403. else
  404. begin
  405. { range checking for open arrays }
  406. end;
  407. end;
  408. inc(p^.left^.location.reference.offset,
  409. p^.right^.value*p^.resulttype^.size);
  410. p^.left^.resulttype:=p^.resulttype;
  411. disposetree(p^.right);
  412. _p:=p^.left;
  413. putnode(p);
  414. p:=_p;
  415. end
  416. else
  417. begin
  418. { quick hack, to overcome Delphi 2 }
  419. if (�cs_regalloc in aktglobalswitches) and
  420. (p^.left^.resulttype^.deftype=arraydef) then
  421. begin
  422. extraoffset:=0;
  423. if (p^.right^.treetype=addn) then
  424. begin
  425. if p^.right^.right^.treetype=ordconstn then
  426. begin
  427. extraoffset:=p^.right^.right^.value;
  428. t:=p^.right^.left;
  429. putnode(p^.right);
  430. putnode(p^.right^.right);
  431. p^.right:=t
  432. end
  433. else if p^.right^.left^.treetype=ordconstn then
  434. begin
  435. extraoffset:=p^.right^.left^.value;
  436. t:=p^.right^.right;
  437. putnode(p^.right);
  438. putnode(p^.right^.left);
  439. p^.right:=t
  440. end;
  441. end
  442. else if (p^.right^.treetype=subn) then
  443. begin
  444. if p^.right^.right^.treetype=ordconstn then
  445. begin
  446. extraoffset:=p^.right^.right^.value;
  447. t:=p^.right^.left;
  448. putnode(p^.right);
  449. putnode(p^.right^.right);
  450. p^.right:=t
  451. end
  452. else if p^.right^.left^.treetype=ordconstn then
  453. begin
  454. extraoffset:=p^.right^.left^.value;
  455. t:=p^.right^.right;
  456. putnode(p^.right);
  457. putnode(p^.right^.left);
  458. p^.right:=t
  459. end;
  460. end;
  461. inc(p^.location.reference.offset,
  462. p^.resulttype^.size*extraoffset);
  463. end;
  464. { calculate from left to right }
  465. if (p^.location.loc<>LOC_REFERENCE) and
  466. (p^.location.loc<>LOC_MEM) then
  467. CGMessage(cg_e_illegal_expression);
  468. pushed:=maybe_push(p^.right^.registers32,p);
  469. secondpass(p^.right);
  470. if pushed then restore(p);
  471. case p^.right^.location.loc of
  472. LOC_REGISTER : begin
  473. ind:=p^.right^.location.register;
  474. case p^.right^.resulttype^.size of
  475. 1: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
  476. $ff,ind)));
  477. 2: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
  478. $ffff,ind)));
  479. end;
  480. end;
  481. LOC_CREGISTER : begin
  482. ind:=getregister32;
  483. emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,ind);
  484. case p^.right^.resulttype^.size of
  485. 1: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
  486. $ff,ind)));
  487. 2: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
  488. $ffff,ind)));
  489. end;
  490. end;
  491. LOC_FLAGS:
  492. begin
  493. ind:=getregister32;
  494. exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.right^.location.resflags],S_B,ind)));
  495. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ff,ind)));
  496. end
  497. else { else outer case }
  498. begin
  499. del_reference(p^.right^.location.reference);
  500. ind:=getregister32;
  501. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  502. newreference(p^.right^.location.reference),ind)));
  503. {Booleans are stored in an 8 bit memory location, so
  504. the use of MOVL is not correct.}
  505. case p^.right^.resulttype^.size of
  506. 1: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
  507. $ff,ind)));
  508. 2: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
  509. $ffff,ind)));
  510. end; { end case }
  511. end; { end else begin }
  512. end;
  513. { produce possible range check code: }
  514. if cs_check_range in aktlocalswitches then
  515. begin
  516. if p^.left^.resulttype^.deftype=arraydef then
  517. begin
  518. new(hp);
  519. reset_reference(hp^);
  520. parraydef(p^.left^.resulttype)^.genrangecheck;
  521. hp^.symbol:=stringdup(parraydef(p^.left^.resulttype)^.getrangecheckstring);
  522. emit_bounds_check(hp^,ind);
  523. end;
  524. end;
  525. { ------------------------ HANDLE INDEXING ----------------------- }
  526. { In Motorola 680x0 mode, displacement can only be of 64K max. }
  527. { Therefore instead of doing a direct displacement, we must first }
  528. { load the new address into an address register. Therefore the }
  529. { symbol is not used. }
  530. if assigned(p^.location.reference.symbol) then
  531. begin
  532. if p^.location.reference.base <> R_NO then
  533. CGMessage(cg_f_secondvecn_base_defined_twice);
  534. p^.location.reference.base:=getaddressreg;
  535. exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_LEA,S_L,newcsymbol(p^.location.reference.symbol^,0),
  536. p^.location.reference.base)));
  537. stringdispose(p^.location.reference.symbol);
  538. end;
  539. if (p^.location.reference.index=R_NO) then
  540. begin
  541. p^.location.reference.index:=ind;
  542. calc_emit_mul;
  543. { here we must check for the offset }
  544. { and if out of bounds for the motorola }
  545. { eg: out of signed d8 then reload index }
  546. { with correct value. }
  547. if p^.location.reference.offset > 127 then
  548. begin
  549. exprasmlist^.concat(new(pai68k,op_const_reg(A_ADD,S_L,p^.location.reference.offset,ind)));
  550. p^.location.reference.offset := 0;
  551. end
  552. else if p^.location.reference.offset < -128 then
  553. begin
  554. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,S_L,-p^.location.reference.offset,ind)));
  555. p^.location.reference.offset := 0;
  556. end;
  557. end
  558. { if no index then allways get an address register !! PM }
  559. else if p^.location.reference.base=R_NO then
  560. begin
  561. case p^.location.reference.scalefactor of
  562. 2 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,1,p^.location.reference.index)));
  563. 4 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,2,p^.location.reference.index)));
  564. 8 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,3,p^.location.reference.index)));
  565. end;
  566. calc_emit_mul;
  567. { we must use address register to put index in base }
  568. { compare with cgi386.pas }
  569. reg := getaddressreg;
  570. p^.location.reference.base := reg;
  571. emit_reg_reg(A_MOVE,S_L,p^.location.reference.index,reg);
  572. ungetregister(p^.location.reference.index);
  573. p^.location.reference.index:=ind;
  574. end
  575. else
  576. begin
  577. reg := getaddressreg;
  578. exprasmlist^.concat(new(pai68k,op_ref_reg(
  579. A_LEA,S_L,newreference(p^.location.reference),
  580. reg)));
  581. ungetregister(p^.location.reference.base);
  582. { the symbol offset is loaded, }
  583. { so release the symbol name and set symbol }
  584. { to nil }
  585. stringdispose(p^.location.reference.symbol);
  586. p^.location.reference.offset:=0;
  587. calc_emit_mul;
  588. p^.location.reference.base:=reg;
  589. ungetregister32(p^.location.reference.index);
  590. p^.location.reference.index:=ind;
  591. end;
  592. end;
  593. end;
  594. {*****************************************************************************
  595. SecondSelfN
  596. *****************************************************************************}
  597. procedure secondselfn(var p : ptree);
  598. begin
  599. clear_reference(p^.location.reference);
  600. p^.location.reference.base:=R_A5;
  601. end;
  602. {*****************************************************************************
  603. SecondWithN
  604. *****************************************************************************}
  605. procedure secondwith(var p : ptree);
  606. var
  607. ref : treference;
  608. symtable : psymtable;
  609. i : longint;
  610. begin
  611. if assigned(p^.left) then
  612. begin
  613. secondpass(p^.left);
  614. ref.symbol:=nil;
  615. gettempofsizereference(4,ref);
  616. exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
  617. newreference(p^.left^.location.reference),R_A0)));
  618. exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,
  619. R_A0,newreference(ref))));
  620. del_reference(p^.left^.location.reference);
  621. { the offset relative to (%ebp) is only needed here! }
  622. symtable:=p^.withsymtable;
  623. for i:=1 to p^.tablecount do
  624. begin
  625. symtable^.datasize:=ref.offset;
  626. symtable:=symtable^.next;
  627. end;
  628. { p^.right can be optimize out !!! }
  629. if p^.right<>nil then
  630. secondpass(p^.right);
  631. { clear some stuff }
  632. ungetiftemp(ref);
  633. end;
  634. end;
  635. end.
  636. {
  637. $Log$
  638. Revision 1.9 1998-11-25 19:12:55 pierre
  639. * var:=new(pointer_type) support added
  640. Revision 1.8 1998/10/14 11:28:21 florian
  641. * emitpushreferenceaddress gets now the asmlist as parameter
  642. * m68k version compiles with -duseansistrings
  643. Revision 1.7 1998/10/14 08:08:54 pierre
  644. * following Peters remark, removed all ifdef in
  645. the systems unit enums
  646. * last bugs of cg68k removed for sysamiga
  647. (sysamiga assembles with as68k !!)
  648. Revision 1.6 1998/10/06 20:49:00 peter
  649. * m68k compiler compiles again
  650. Revision 1.5 1998/09/17 09:42:28 peter
  651. + pass_2 for cg386
  652. * Message() -> CGMessage() for pass_1/pass_2
  653. Revision 1.4 1998/09/14 10:44:02 peter
  654. * all internal RTL functions start with FPC_
  655. Revision 1.3 1998/09/11 12:29:44 pierre
  656. * removed explicit range_checking as it is buggy
  657. Revision 1.2.2.1 1998/09/11 12:08:59 pierre
  658. * removed explicit range_check was buggy
  659. Revision 1.2 1998/09/07 18:45:57 peter
  660. * update smartlinking, uses getdatalabel
  661. * renamed ptree.value vars to value_str,value_real,value_set
  662. Revision 1.1 1998/09/01 09:07:09 peter
  663. * m68k fixes, splitted cg68k like cgi386
  664. }