cg68kcal.pas 57 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 by Florian Klaempfl
  4. Generate m68k assembler for in call 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 cg68kcal;
  19. interface
  20. uses
  21. symtable,tree;
  22. { save the size of pushed parameter }
  23. var
  24. pushedparasize : longint;
  25. procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
  26. push_from_left_to_right : boolean);
  27. procedure secondcalln(var p : ptree);
  28. procedure secondprocinline(var p : ptree);
  29. implementation
  30. uses
  31. cobjects,verbose,globals,systems,
  32. aasm,types,
  33. hcodegen,temp_gen,pass_2,
  34. m68k,cga68k,tgen68k,cg68kld;
  35. {*****************************************************************************
  36. SecondCallParaN
  37. *****************************************************************************}
  38. procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
  39. push_from_left_to_right : boolean);
  40. procedure maybe_push_open_array_high;
  41. var
  42. r : preference;
  43. begin
  44. { open array ? }
  45. { defcoll^.data can be nil for read/write }
  46. if assigned(defcoll^.data) and
  47. is_open_array(defcoll^.data) then
  48. begin
  49. inc(pushedparasize,4);
  50. { push high }
  51. if is_open_array(p^.left^.resulttype) then
  52. begin
  53. new(r);
  54. reset_reference(r^);
  55. r^.base:=highframepointer;
  56. r^.offset:=highoffset+4;
  57. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_SPPUSH)));
  58. end
  59. else
  60. push_int(parraydef(p^.left^.resulttype)^.highrange-parraydef(p^.left^.resulttype)^.lowrange);
  61. end;
  62. end;
  63. var
  64. size : longint;
  65. stackref : treference;
  66. otlabel,hlabel,oflabel : plabel;
  67. { temporary variables: }
  68. reg : tregister;
  69. tempdeftype : tdeftype;
  70. tempreference : treference;
  71. r : preference;
  72. s : topsize;
  73. op : tasmop;
  74. begin
  75. { push from left to right if specified }
  76. if push_from_left_to_right and assigned(p^.right) then
  77. secondcallparan(p^.right,defcoll^.next,push_from_left_to_right);
  78. otlabel:=truelabel;
  79. oflabel:=falselabel;
  80. getlabel(truelabel);
  81. getlabel(falselabel);
  82. secondpass(p^.left);
  83. { in codegen.handleread.. defcoll^.data is set to nil }
  84. if assigned(defcoll^.data) and
  85. (defcoll^.data^.deftype=formaldef) then
  86. begin
  87. { allow @var }
  88. if p^.left^.treetype=addrn then
  89. begin
  90. { allways a register }
  91. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,p^.left^.location.register,R_SPPUSH)));
  92. ungetregister32(p^.left^.location.register);
  93. end
  94. else
  95. begin
  96. if (p^.left^.location.loc<>LOC_REFERENCE) and
  97. (p^.left^.location.loc<>LOC_MEM) then
  98. CGMessage(type_e_mismatch)
  99. else
  100. begin
  101. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  102. del_reference(p^.left^.location.reference);
  103. end;
  104. end;
  105. inc(pushedparasize,4);
  106. end
  107. { handle call by reference parameter }
  108. else if (defcoll^.paratyp=vs_var) then
  109. begin
  110. if (p^.left^.location.loc<>LOC_REFERENCE) then
  111. CGMessage(cg_e_var_must_be_reference);
  112. maybe_push_open_array_high;
  113. inc(pushedparasize,4);
  114. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  115. del_reference(p^.left^.location.reference);
  116. end
  117. else
  118. begin
  119. tempdeftype:=p^.resulttype^.deftype;
  120. if tempdeftype=filedef then
  121. CGMessage(cg_e_file_must_call_by_reference);
  122. if (defcoll^.paratyp=vs_const) and
  123. dont_copy_const_param(p^.resulttype) then
  124. begin
  125. maybe_push_open_array_high;
  126. inc(pushedparasize,4);
  127. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  128. del_reference(p^.left^.location.reference);
  129. end
  130. else
  131. case p^.left^.location.loc of
  132. LOC_REGISTER,
  133. LOC_CREGISTER : begin
  134. { HERE IS A BIG PROBLEM }
  135. { --> We *MUST* know the data size to push }
  136. { for the moment, we can say that the savesize }
  137. { indicates the parameter size to push, but }
  138. { that is CERTAINLY NOT TRUE! }
  139. { CAN WE USE LIKE LOC_MEM OR LOC_REFERENCE?? }
  140. case integer(p^.left^.resulttype^.savesize) of
  141. 1 : Begin
  142. { A byte sized value normally increments }
  143. { the SP by 2, BUT because how memory has }
  144. { been setup OR because of GAS, a byte sized }
  145. { push CRASHES the Amiga, therefore, we do it }
  146. { by hand instead. }
  147. { PUSH A WORD SHIFTED LEFT 8 }
  148. reg := getregister32;
  149. emit_reg_reg(A_MOVE, S_B, p^.left^.location.register, reg);
  150. exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_W,
  151. 8, reg)));
  152. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,
  153. reg,R_SPPUSH)));
  154. { offset will be TWO greater }
  155. inc(pushedparasize,2);
  156. ungetregister32(reg);
  157. ungetregister32(p^.left^.location.register);
  158. end;
  159. 2 :
  160. Begin
  161. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,
  162. p^.left^.location.register,R_SPPUSH)));
  163. inc(pushedparasize,2);
  164. ungetregister32(p^.left^.location.register);
  165. end;
  166. 4 : Begin
  167. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
  168. p^.left^.location.register,R_SPPUSH)));
  169. inc(pushedparasize,4);
  170. ungetregister32(p^.left^.location.register);
  171. end;
  172. else
  173. Begin
  174. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
  175. p^.left^.location.register,R_SPPUSH)));
  176. inc(pushedparasize,4);
  177. ungetregister32(p^.left^.location.register);
  178. end;
  179. end; { end case }
  180. end;
  181. LOC_FPU : begin
  182. size:=pfloatdef(p^.left^.resulttype)^.size;
  183. inc(pushedparasize,size);
  184. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_L,size,R_SP)));
  185. new(r);
  186. reset_reference(r^);
  187. r^.base:=R_SP;
  188. s:=getfloatsize(pfloatdef(p^.left^.resulttype)^.typ);
  189. if (cs_fp_emulation in aktmoduleswitches) or (s=S_FS) then
  190. begin
  191. { when in emulation mode... }
  192. { only single supported!!! }
  193. exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,
  194. p^.left^.location.fpureg,r)));
  195. end
  196. else
  197. { convert back from extended to normal type }
  198. exprasmlist^.concat(new(pai68k,op_reg_ref(A_FMOVE,s,
  199. p^.left^.location.fpureg,r)));
  200. end;
  201. LOC_REFERENCE,LOC_MEM :
  202. begin
  203. tempreference:=p^.left^.location.reference;
  204. del_reference(p^.left^.location.reference);
  205. case p^.resulttype^.deftype of
  206. enumdef,
  207. orddef : begin
  208. case p^.resulttype^.size of
  209. 4 : begin
  210. emit_push_mem(tempreference);
  211. inc(pushedparasize,4);
  212. end;
  213. 1 : Begin
  214. { We push a BUT, the SP is incremented by 2 }
  215. { as specified in the Motorola Prog's Ref Manual }
  216. { Therefore offet increments BY 2!!! }
  217. { BUG??? ... }
  218. { SWAP OPERANDS: }
  219. if tempreference.isintvalue then
  220. Begin
  221. exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,
  222. tempreference.offset shl 8,R_SPPUSH)));
  223. end
  224. else
  225. Begin
  226. { A byte sized value normally increments }
  227. { the SP by 2, BUT because how memory has }
  228. { been setup OR because of GAS, a byte sized }
  229. { push CRASHES the Amiga, therefore, we do it }
  230. { by hand instead. }
  231. { PUSH A WORD SHIFTED LEFT 8 }
  232. reg:=getregister32;
  233. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,
  234. newreference(tempreference),reg)));
  235. exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_W,
  236. 8, reg)));
  237. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,
  238. reg,R_SPPUSH)));
  239. ungetregister32(reg);
  240. { exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
  241. newreference(tempreference),R_SPPUSH))); }
  242. end;
  243. inc(pushedparasize,2);
  244. end;
  245. 2 : begin
  246. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
  247. newreference(tempreference),R_SPPUSH)));
  248. inc(pushedparasize,2);
  249. end;
  250. end;
  251. end;
  252. floatdef : begin
  253. case pfloatdef(p^.resulttype)^.typ of
  254. f32bit,
  255. s32real :
  256. begin
  257. emit_push_mem(tempreference);
  258. inc(pushedparasize,4);
  259. end;
  260. s64real:
  261. {s64bit }
  262. begin
  263. inc(tempreference.offset,4);
  264. emit_push_mem(tempreference);
  265. dec(tempreference.offset,4);
  266. emit_push_mem(tempreference);
  267. inc(pushedparasize,8);
  268. end;
  269. {$ifdef use48}
  270. s48real : begin
  271. end;
  272. {$endif}
  273. s80real : begin
  274. CGMessage(cg_f_extended_cg68k_not_supported);
  275. { inc(tempreference.offset,6);
  276. emit_push_mem(tempreference);
  277. dec(tempreference.offset,4);
  278. emit_push_mem(tempreference);
  279. dec(tempreference.offset,2);
  280. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
  281. newreference(tempreference),R_SPPUSH)));
  282. inc(pushedparasize,extended_size);}
  283. end;
  284. end;
  285. end;
  286. pointerdef,procvardef,
  287. classrefdef: begin
  288. emit_push_mem(tempreference);
  289. inc(pushedparasize,4);
  290. end;
  291. arraydef,recorddef,stringdef,setdef,objectdef :
  292. begin
  293. if ((p^.resulttype^.deftype=setdef) and
  294. (psetdef(p^.resulttype)^.settype=smallset)) then
  295. begin
  296. emit_push_mem(tempreference);
  297. inc(pushedparasize,4);
  298. end
  299. else
  300. begin
  301. size:=p^.resulttype^.size;
  302. { Alignment }
  303. {
  304. if (size>=4) and ((size and 3)<>0) then
  305. inc(size,4-(size and 3))
  306. else if (size>=2) and ((size and 1)<>0) then
  307. inc(size,2-(size and 1))
  308. else
  309. if size=1 then size:=2;
  310. }
  311. { create stack space }
  312. if (size > 0) and (size < 9) then
  313. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_L,size,R_SP)))
  314. else
  315. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBA,
  316. S_L,size,R_SP)));
  317. inc(pushedparasize,size);
  318. { create stack reference }
  319. stackref.symbol := nil;
  320. clear_reference(stackref);
  321. stackref.base:=R_SP;
  322. { produce copy }
  323. if p^.resulttype^.deftype=stringdef then
  324. begin
  325. copystring(stackref,p^.left^.location.reference,
  326. pstringdef(p^.resulttype)^.len);
  327. end
  328. else
  329. begin
  330. concatcopy(p^.left^.location.reference,
  331. stackref,p^.resulttype^.size,true);
  332. end;
  333. end;
  334. end;
  335. else CGMessage(cg_e_illegal_expression);
  336. end;
  337. end;
  338. LOC_JUMP : begin
  339. getlabel(hlabel);
  340. inc(pushedparasize,2);
  341. emitl(A_LABEL,truelabel);
  342. exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,1 shl 8,R_SPPUSH)));
  343. emitl(A_JMP,hlabel);
  344. emitl(A_LABEL,falselabel);
  345. exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,0,R_SPPUSH)));
  346. emitl(A_LABEL,hlabel);
  347. end;
  348. LOC_FLAGS : begin
  349. exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.left^.location.resflags],S_B,
  350. R_D0)));
  351. exprasmlist^.concat(new(pai68k,op_reg(A_NEG, S_B, R_D0)));
  352. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_W,$ff, R_D0)));
  353. inc(pushedparasize,2);
  354. { ----------------- HACK ----------------------- }
  355. { HERE IS THE BYTE SIZED PUSH HACK ONCE AGAIN }
  356. { SHIFT LEFT THE BYTE TO MAKE IT WORK! }
  357. exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_W,8, R_D0)));
  358. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,R_D0,R_SPPUSH)));
  359. end;
  360. end;
  361. end;
  362. freelabel(truelabel);
  363. freelabel(falselabel);
  364. truelabel:=otlabel;
  365. falselabel:=oflabel;
  366. { push from right to left }
  367. if not push_from_left_to_right and assigned(p^.right) then
  368. secondcallparan(p^.right,defcoll^.next,push_from_left_to_right);
  369. end;
  370. {*****************************************************************************
  371. SecondCallN
  372. *****************************************************************************}
  373. procedure secondcalln(var p : ptree);
  374. var
  375. unusedregisters : tregisterset;
  376. pushed : tpushed;
  377. funcretref : treference;
  378. hregister : tregister;
  379. oldpushedparasize : longint;
  380. { true if a5 must be loaded again after the subroutine }
  381. loada5 : boolean;
  382. { true if a virtual method must be called directly }
  383. no_virtual_call : boolean;
  384. { true if we produce a con- or destrutor in a call }
  385. is_con_or_destructor : boolean;
  386. { true if a constructor is called again }
  387. extended_new : boolean;
  388. { adress returned from an I/O-error }
  389. iolabel : plabel;
  390. { lexlevel count }
  391. i : longint;
  392. { help reference pointer }
  393. r : preference;
  394. pp,params : ptree;
  395. { temp register allocation }
  396. reg: tregister;
  397. { help reference pointer }
  398. ref: preference;
  399. label
  400. dont_call;
  401. begin
  402. extended_new:=false;
  403. iolabel:=nil;
  404. loada5:=true;
  405. no_virtual_call:=false;
  406. unusedregisters:=unused;
  407. if not assigned(p^.procdefinition) then
  408. exit;
  409. { only if no proc var }
  410. if not(assigned(p^.right)) then
  411. is_con_or_destructor:=((p^.procdefinition^.options and poconstructor)<>0)
  412. or ((p^.procdefinition^.options and podestructor)<>0);
  413. { proc variables destroy all registers }
  414. if (p^.right=nil) and
  415. { virtual methods too }
  416. ((p^.procdefinition^.options and povirtualmethod)=0) then
  417. begin
  418. if ((p^.procdefinition^.options and poiocheck)<>0)
  419. and (cs_check_io in aktlocalswitches) then
  420. begin
  421. getlabel(iolabel);
  422. emitl(A_LABEL,iolabel);
  423. end
  424. else iolabel:=nil;
  425. { save all used registers }
  426. pushusedregisters(pushed,p^.procdefinition^.usedregisters);
  427. { give used registers through }
  428. usedinproc:=usedinproc or p^.procdefinition^.usedregisters;
  429. end
  430. else
  431. begin
  432. pushusedregisters(pushed,$ffff);
  433. usedinproc:=$ffff;
  434. { no IO check for methods and procedure variables }
  435. iolabel:=nil;
  436. end;
  437. { generate the code for the parameter and push them }
  438. oldpushedparasize:=pushedparasize;
  439. pushedparasize:=0;
  440. if (p^.resulttype<>pdef(voiddef)) and
  441. ret_in_param(p^.resulttype) then
  442. begin
  443. funcretref.symbol:=nil;
  444. {$ifdef test_dest_loc}
  445. if dest_loc_known and (dest_loc_tree=p) and
  446. (dest_loc.loc in [LOC_REFERENCE,LOC_MEM]) then
  447. begin
  448. funcretref:=dest_loc.reference;
  449. if assigned(dest_loc.reference.symbol) then
  450. funcretref.symbol:=stringdup(dest_loc.reference.symbol^);
  451. in_dest_loc:=true;
  452. end
  453. else
  454. {$endif test_dest_loc}
  455. gettempofsizereference(p^.procdefinition^.retdef^.size,funcretref);
  456. end;
  457. if assigned(p^.left) then
  458. begin
  459. pushedparasize:=0;
  460. { be found elsewhere }
  461. if assigned(p^.right) then
  462. secondcallparan(p^.left,pprocvardef(p^.right^.resulttype)^.para1,
  463. (p^.procdefinition^.options and poleftright)<>0)
  464. else
  465. secondcallparan(p^.left,p^.procdefinition^.para1,
  466. (p^.procdefinition^.options and poleftright)<>0);
  467. end;
  468. params:=p^.left;
  469. p^.left:=nil;
  470. if ret_in_param(p^.resulttype) then
  471. begin
  472. emitpushreferenceaddr(exprasmlist,funcretref);
  473. inc(pushedparasize,4);
  474. end;
  475. { overloaded operator have no symtable }
  476. if (p^.right=nil) then
  477. begin
  478. { push self }
  479. if assigned(p^.symtable) and
  480. (p^.symtable^.symtabletype=withsymtable) then
  481. begin
  482. { dirty trick to avoid the secondcall below }
  483. p^.methodpointer:=genzeronode(callparan);
  484. p^.methodpointer^.location.loc:=LOC_REGISTER;
  485. p^.methodpointer^.location.register:=R_A5;
  486. { change dispose type !! }
  487. p^.disposetyp:=dt_mbleft_and_method;
  488. { make a reference }
  489. new(r);
  490. reset_reference(r^);
  491. r^.offset:=p^.symtable^.datasize;
  492. r^.base:=procinfo.framepointer;
  493. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_A5)));
  494. end;
  495. { push self }
  496. if assigned(p^.symtable) and
  497. ((p^.symtable^.symtabletype=objectsymtable) or
  498. (p^.symtable^.symtabletype=withsymtable)) then
  499. begin
  500. if assigned(p^.methodpointer) then
  501. begin
  502. case p^.methodpointer^.treetype of
  503. typen : begin
  504. { direct call to inherited method }
  505. if (p^.procdefinition^.options and poabstractmethod)<>0 then
  506. begin
  507. CGMessage(cg_e_cant_call_abstract_method);
  508. goto dont_call;
  509. end;
  510. { generate no virtual call }
  511. no_virtual_call:=true;
  512. if (p^.symtableprocentry^.properties and sp_static)<>0 then
  513. begin
  514. { well lets put the VMT address directly into a5 }
  515. { it is kind of dirty but that is the simplest }
  516. { way to accept virtual static functions (PM) }
  517. loada5:=true;
  518. exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_MOVE,S_L,
  519. newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0),R_A5)));
  520. concat_external(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
  521. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
  522. end
  523. else
  524. { this is a member call, so A5 isn't modfied }
  525. loada5:=false;
  526. if not(is_con_or_destructor and
  527. pobjectdef(p^.methodpointer^.resulttype)^.isclass and
  528. assigned(aktprocsym) and
  529. ((aktprocsym^.definition^.options and
  530. (poconstructor or podestructor))<>0)) then
  531. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
  532. { if an inherited con- or destructor should be }
  533. { called in a con- or destructor then a warning }
  534. { will be made }
  535. { con- and destructors need a pointer to the vmt }
  536. if is_con_or_destructor and
  537. ((pobjectdef(p^.methodpointer^.resulttype)^.options and oois_class)=0) and
  538. assigned(aktprocsym) then
  539. begin
  540. if not ((aktprocsym^.definition^.options
  541. and (poconstructor or podestructor))<>0) then
  542. CGMessage(cg_w_member_cd_call_from_method);
  543. end;
  544. { con- and destructors need a pointer to the vmt }
  545. if is_con_or_destructor then
  546. begin
  547. { classes need the mem ! }
  548. if ((pobjectdef(p^.methodpointer^.resulttype)^.options and
  549. oois_class)=0) then
  550. push_int(0)
  551. else
  552. begin
  553. exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,
  554. S_L,newcsymbol(pobjectdef(p^.methodpointer^.
  555. resulttype)^.vmt_mangledname,0))));
  556. concat_external(pobjectdef(p^.methodpointer^.resulttype)^.
  557. vmt_mangledname,EXT_NEAR);
  558. end;
  559. end;
  560. end;
  561. hnewn : begin
  562. { extended syntax of new }
  563. { A5 must be zero }
  564. exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,0,R_A5)));
  565. emit_reg_reg(A_MOVE,S_L,R_A5, R_SPPUSH);
  566. { insert the vmt }
  567. exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,
  568. newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
  569. concat_external(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
  570. extended_new:=true;
  571. end;
  572. hdisposen : begin
  573. secondpass(p^.methodpointer);
  574. { destructor with extended syntax called from dispose }
  575. { hdisposen always deliver LOC_REFRENZ }
  576. exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
  577. newreference(p^.methodpointer^.location.reference),R_A5)));
  578. del_reference(p^.methodpointer^.location.reference);
  579. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
  580. exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,
  581. newcsymbol(pobjectdef
  582. (p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
  583. concat_external(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
  584. end;
  585. else
  586. begin
  587. { call to a instance member }
  588. if (p^.symtable^.symtabletype<>withsymtable) then
  589. begin
  590. secondpass(p^.methodpointer);
  591. case p^.methodpointer^.location.loc of
  592. LOC_REGISTER :
  593. begin
  594. ungetregister32(p^.methodpointer^.location.register);
  595. emit_reg_reg(A_MOVE,S_L,p^.methodpointer^.location.register,R_A5);
  596. end;
  597. else
  598. begin
  599. if (p^.methodpointer^.resulttype^.deftype=objectdef) and
  600. pobjectdef(p^.methodpointer^.resulttype)^.isclass then
  601. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  602. newreference(p^.methodpointer^.location.reference),R_A5)))
  603. else
  604. Begin
  605. exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
  606. newreference(p^.methodpointer^.location.reference),R_A5)));
  607. end;
  608. del_reference(p^.methodpointer^.location.reference);
  609. end;
  610. end;
  611. end;
  612. { when calling a class method, we have
  613. to load ESI with the VMT !
  614. But that's wrong, if we call a class method via self
  615. }
  616. if ((p^.procdefinition^.options and poclassmethod)<>0)
  617. and not(p^.methodpointer^.treetype=selfn) then
  618. begin
  619. { class method needs current VMT }
  620. new(r);
  621. reset_reference(r^);
  622. r^.base:=R_A5;
  623. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_A5)));
  624. end;
  625. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
  626. if is_con_or_destructor then
  627. begin
  628. { classes don't get a VMT pointer pushed }
  629. if (p^.methodpointer^.resulttype^.deftype=objectdef) and
  630. not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  631. begin
  632. if ((p^.procdefinition^.options and poconstructor)<>0) then
  633. begin
  634. { it's no bad idea, to insert the VMT }
  635. exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,
  636. newcsymbol(pobjectdef(
  637. p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
  638. concat_external(pobjectdef(
  639. p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
  640. end
  641. { destructors haven't to dispose the instance, if this is }
  642. { a direct call }
  643. else
  644. push_int(0);
  645. end;
  646. end;
  647. end;
  648. end;
  649. end
  650. else
  651. begin
  652. if ((p^.procdefinition^.options and poclassmethod)<>0) and
  653. not(
  654. assigned(aktprocsym) and
  655. ((aktprocsym^.definition^.options and poclassmethod)<>0)
  656. ) then
  657. begin
  658. { class method needs current VMT }
  659. new(r);
  660. reset_reference(r^);
  661. r^.base:=R_A5;
  662. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_A5)));
  663. end
  664. else
  665. begin
  666. { member call, A5 isn't modified }
  667. loada5:=false;
  668. end;
  669. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
  670. { but a con- or destructor here would probably almost }
  671. { always be placed wrong }
  672. if is_con_or_destructor then
  673. begin
  674. CGMessage(cg_w_member_cd_call_from_method);
  675. { not insert VMT pointer } { VMT-Zeiger nicht eintragen }
  676. push_int(0);
  677. end;
  678. end;
  679. end;
  680. { push base pointer ?}
  681. if (lexlevel>1) and assigned(pprocdef(p^.procdefinition)^.parast) and
  682. ((p^.procdefinition^.parast^.symtablelevel)>2) then
  683. begin
  684. { if we call a nested function in a method, we must }
  685. { push also SELF! }
  686. { THAT'S NOT TRUE, we have to load ESI via frame pointer }
  687. { access }
  688. {
  689. begin
  690. loadesi:=false;
  691. exprasmlist^.concat(new(pai68k,op_reg(A_PUSH,S_L,R_ESI)));
  692. end;
  693. }
  694. if lexlevel=(p^.procdefinition^.parast^.symtablelevel) then
  695. begin
  696. new(r);
  697. reset_reference(r^);
  698. r^.offset:=procinfo.framepointer_offset;
  699. r^.base:=procinfo.framepointer;
  700. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_SPPUSH)))
  701. end
  702. { this is only true if the difference is one !!
  703. but it cannot be more !! }
  704. else if lexlevel=(p^.procdefinition^.parast^.symtablelevel)-1 then
  705. begin
  706. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,procinfo.framepointer,R_SPPUSH)))
  707. end
  708. else if lexlevel>(p^.procdefinition^.parast^.symtablelevel) then
  709. begin
  710. hregister:=getaddressreg;
  711. new(r);
  712. reset_reference(r^);
  713. r^.offset:=procinfo.framepointer_offset;
  714. r^.base:=procinfo.framepointer;
  715. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,hregister)));
  716. for i:=(p^.procdefinition^.parast^.symtablelevel) to lexlevel-1 do
  717. begin
  718. new(r);
  719. reset_reference(r^);
  720. {we should get the correct frame_pointer_offset at each level
  721. how can we do this !!! }
  722. r^.offset:=procinfo.framepointer_offset;
  723. r^.base:=hregister;
  724. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,hregister)));
  725. end;
  726. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,hregister,R_SPPUSH)));
  727. ungetregister32(hregister);
  728. end
  729. else
  730. internalerror(25000);
  731. end;
  732. { exported methods should be never called direct }
  733. if (p^.procdefinition^.options and poexports)<>0 then
  734. CGMessage(cg_e_dont_call_exported_direct);
  735. if ((p^.procdefinition^.options and povirtualmethod)<>0) and
  736. not(no_virtual_call) then
  737. begin
  738. { static functions contain the vmt_address in ESI }
  739. { also class methods }
  740. if assigned(aktprocsym) then
  741. begin
  742. if ((aktprocsym^.properties and sp_static)<>0) or
  743. ((aktprocsym^.definition^.options and poclassmethod)<>0) or
  744. ((p^.procdefinition^.options and postaticmethod)<>0) or
  745. { A5 is already loaded }
  746. ((p^.procdefinition^.options and poclassmethod)<>0)then
  747. begin
  748. new(r);
  749. reset_reference(r^);
  750. r^.base:=R_a5;
  751. end
  752. else
  753. begin
  754. new(r);
  755. reset_reference(r^);
  756. r^.base:=R_a5;
  757. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_a0)));
  758. new(r);
  759. reset_reference(r^);
  760. r^.base:=R_a0;
  761. end;
  762. end
  763. else
  764. begin
  765. new(r);
  766. reset_reference(r^);
  767. r^.base:=R_a5;
  768. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_a0)));
  769. new(r);
  770. reset_reference(r^);
  771. r^.base:=R_a0;
  772. end;
  773. if p^.procdefinition^.extnumber=-1 then
  774. internalerror($Da);
  775. r^.offset:=p^.procdefinition^.extnumber*4+12;
  776. if (cs_check_range in aktlocalswitches) then
  777. begin
  778. { If the base is already A0, the no instruction will }
  779. { be emitted! }
  780. emit_reg_reg(A_MOVE,S_L,r^.base,R_A0);
  781. emitcall('FPC_CHECK_OBJECT',true);
  782. end;
  783. { This was wrong we must then load the address into the }
  784. { register a0 and/or a5 }
  785. { Because doing an indirect call with offset is NOT }
  786. { allowed on the m68k! }
  787. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(r^),R_A0)));
  788. { clear the reference }
  789. reset_reference(r^);
  790. r^.base := R_A0;
  791. exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,r)));
  792. end
  793. else if (p^.procdefinition^.options and popalmossyscall)<>0 then
  794. begin
  795. exprasmlist^.concat(new(pai68k,op_const(A_TRAP,S_NO,15)));
  796. exprasmlist^.concat(new(pai_const,init_16bit(p^.procdefinition^.extnumber)));
  797. end
  798. else
  799. emitcall(p^.procdefinition^.mangledname,
  800. p^.symtableproc^.symtabletype=unitsymtable);
  801. if ((p^.procdefinition^.options and poclearstack)<>0) then
  802. begin
  803. if (pushedparasize > 0) and (pushedparasize < 9) then
  804. { restore the stack, to its initial value }
  805. exprasmlist^.concat(new(pai68k,op_const_reg(A_ADDQ,S_L,pushedparasize,R_SP)))
  806. else
  807. { restore the stack, to its initial value }
  808. exprasmlist^.concat(new(pai68k,op_const_reg(A_ADDA,S_L,pushedparasize,R_SP)));
  809. end;
  810. end
  811. else
  812. begin
  813. secondpass(p^.right);
  814. case p^.right^.location.loc of
  815. LOC_REGISTER,
  816. LOC_CREGISTER : begin
  817. if p^.right^.location.register in [R_D0..R_D7] then
  818. begin
  819. reg := getaddressreg;
  820. emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,reg);
  821. new(ref);
  822. reset_reference(ref^);
  823. ref^.base := reg;
  824. exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,ref)));
  825. ungetregister(reg);
  826. end
  827. else
  828. begin
  829. new(ref);
  830. reset_reference(ref^);
  831. ref^.base := p^.right^.location.register;
  832. exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,ref)));
  833. end;
  834. ungetregister32(p^.right^.location.register);
  835. end
  836. else
  837. begin
  838. if assigned(p^.right^.location.reference.symbol) then
  839. { Here we have a symbolic name to the routine, so solve }
  840. { problem by loading the address first, and then emitting }
  841. { the call. }
  842. begin
  843. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  844. newreference(p^.right^.location.reference),R_A1)));
  845. new(ref);
  846. reset_reference(ref^);
  847. ref^.base := R_A1;
  848. exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,ref)));
  849. end
  850. else
  851. begin
  852. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  853. newreference(p^.right^.location.reference),R_A1)));
  854. new(ref);
  855. reset_reference(ref^);
  856. ref^.base := R_A1;
  857. exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,ref)));
  858. end;
  859. del_reference(p^.right^.location.reference);
  860. end;
  861. end;
  862. end;
  863. dont_call:
  864. pushedparasize:=oldpushedparasize;
  865. unused:=unusedregisters;
  866. { handle function results }
  867. if p^.resulttype<>pdef(voiddef) then
  868. begin
  869. { a contructor could be a function with boolean result }
  870. if (p^.right=nil) and
  871. ((p^.procdefinition^.options and poconstructor)<>0) and
  872. { quick'n'dirty check if it is a class or an object }
  873. (p^.resulttype^.deftype=orddef) then
  874. begin
  875. p^.location.loc:=LOC_FLAGS;
  876. p^.location.resflags:=F_NE;
  877. if extended_new then
  878. begin
  879. {$ifdef test_dest_loc}
  880. if dest_loc_known and (dest_loc_tree=p) then
  881. mov_reg_to_dest(p,S_L,R_EAX)
  882. else
  883. {$endif test_dest_loc}
  884. hregister:=getregister32;
  885. emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
  886. p^.location.register:=hregister;
  887. end;
  888. end
  889. { structed results are easy to handle.... }
  890. else if ret_in_param(p^.resulttype) then
  891. begin
  892. p^.location.loc:=LOC_MEM;
  893. stringdispose(p^.location.reference.symbol);
  894. p^.location.reference:=funcretref;
  895. end
  896. else
  897. begin
  898. if (p^.resulttype^.deftype=orddef) then
  899. begin
  900. p^.location.loc:=LOC_REGISTER;
  901. case porddef(p^.resulttype)^.typ of
  902. s32bit,u32bit :
  903. begin
  904. hregister:=getregister32;
  905. emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
  906. p^.location.register:=hregister;
  907. end;
  908. uchar,u8bit,bool8bit,s8bit :
  909. begin
  910. hregister:=getregister32;
  911. emit_reg_reg(A_MOVE,S_B,R_D0,hregister);
  912. p^.location.register:=hregister;
  913. end;
  914. s16bit,u16bit :
  915. begin
  916. hregister:=getregister32;
  917. emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
  918. p^.location.register:=hregister;
  919. end;
  920. else internalerror(7);
  921. end
  922. end
  923. else if (p^.resulttype^.deftype=floatdef) then
  924. case pfloatdef(p^.resulttype)^.typ of
  925. f32bit :
  926. begin
  927. p^.location.loc:=LOC_REGISTER;
  928. hregister:=getregister32;
  929. emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
  930. p^.location.register:=hregister;
  931. end;
  932. s32real : Begin
  933. p^.location.loc:=LOC_FPU;
  934. hregister:=getregister32;
  935. emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
  936. p^.location.fpureg:=hregister;
  937. end;
  938. s64bit,s64real,s80real: begin
  939. if cs_fp_emulation in aktmoduleswitches then
  940. begin
  941. p^.location.loc:=LOC_FPU;
  942. hregister:=getregister32;
  943. emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
  944. p^.location.fpureg:=hregister;
  945. end
  946. else
  947. begin
  948. { TRUE FPU mode }
  949. p^.location.loc:=LOC_FPU;
  950. { on exit of function result in R_FP0 }
  951. p^.location.fpureg:=R_FP0;
  952. end;
  953. end;
  954. else
  955. begin
  956. p^.location.loc:=LOC_FPU;
  957. p^.location.fpureg:=R_FP0;
  958. end;
  959. end {end case }
  960. else
  961. begin
  962. p^.location.loc:=LOC_REGISTER;
  963. hregister:=getregister32;
  964. emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
  965. p^.location.register:=hregister;
  966. end;
  967. end;
  968. end;
  969. { perhaps i/o check ? }
  970. if iolabel<>nil then
  971. begin
  972. exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,newcsymbol(lab2str(iolabel),0))));
  973. emitcall('FPC_IOCHECK',true);
  974. end;
  975. { restore registers }
  976. popusedregisters(pushed);
  977. { at last, restore instance pointer (SELF) }
  978. if loada5 then
  979. maybe_loada5;
  980. pp:=params;
  981. while assigned(pp) do
  982. begin
  983. if assigned(pp^.left) then
  984. if (pp^.left^.location.loc=LOC_REFERENCE) or
  985. (pp^.left^.location.loc=LOC_MEM) then
  986. ungetiftemp(pp^.left^.location.reference);
  987. pp:=pp^.right;
  988. end;
  989. disposetree(params);
  990. end;
  991. {*****************************************************************************
  992. SecondProcInlineN
  993. *****************************************************************************}
  994. procedure secondprocinline(var p : ptree);
  995. begin
  996. InternalError(132421);
  997. end;
  998. end.
  999. {
  1000. $Log$
  1001. Revision 1.10 1998-10-15 12:41:16 pierre
  1002. * last memory leaks found when compiler
  1003. a native atari compiler fixed
  1004. Revision 1.9 1998/10/14 11:28:16 florian
  1005. * emitpushreferenceaddress gets now the asmlist as parameter
  1006. * m68k version compiles with -duseansistrings
  1007. Revision 1.8 1998/10/13 16:50:04 pierre
  1008. * undid some changes of Peter that made the compiler wrong
  1009. for m68k (I had to reinsert some ifdefs)
  1010. * removed several memory leaks under m68k
  1011. * removed the meory leaks for assembler readers
  1012. * cross compiling shoud work again better
  1013. ( crosscompiling sysamiga works
  1014. but as68k still complain about some code !)
  1015. Revision 1.7 1998/10/13 08:19:27 pierre
  1016. + source_os is now set correctly for cross-processor compilers
  1017. (tos contains all target_infos and
  1018. we use CPU86 and CPU68 conditionnals to
  1019. get the source operating system
  1020. this only works if you do not undefine
  1021. the source target !!)
  1022. * several cg68k memory leaks fixed
  1023. + started to change the code so that it should be possible to have
  1024. a complete compiler (both for m68k and i386 !!)
  1025. Revision 1.6 1998/09/20 12:26:38 peter
  1026. * merged fixes
  1027. Revision 1.5 1998/09/17 09:42:22 peter
  1028. + pass_2 for cg386
  1029. * Message() -> CGMessage() for pass_1/pass_2
  1030. Revision 1.4 1998/09/14 10:43:55 peter
  1031. * all internal RTL functions start with FPC_
  1032. Revision 1.3.2.1 1998/09/20 12:20:09 peter
  1033. * Fixed stack not on 4 byte boundary when doing a call
  1034. Revision 1.3 1998/09/04 08:41:43 peter
  1035. * updated some error CGMessages
  1036. Revision 1.2 1998/09/01 12:47:59 peter
  1037. * use pdef^.size instead of orddef^.typ
  1038. Revision 1.1 1998/09/01 09:07:09 peter
  1039. * m68k fixes, splitted cg68k like cgi386
  1040. }