cg68kmem.pas 30 KB

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