cg386cal.pas 75 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 by Florian Klaempfl
  4. Generate i386 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 cg386cal;
  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,inlined : boolean;para_offset : longint);
  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. i386,cgai386,tgeni386,cg386ld;
  35. {*****************************************************************************
  36. SecondCallParaN
  37. *****************************************************************************}
  38. procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
  39. push_from_left_to_right,inlined : boolean;para_offset : longint);
  40. procedure maybe_push_open_array_high;
  41. var
  42. r : preference;
  43. hreg : tregister;
  44. href : treference;
  45. len : longint;
  46. begin
  47. { open array ? }
  48. { defcoll^.data can be nil for read/write }
  49. if assigned(defcoll^.data) and
  50. is_open_array(defcoll^.data) then
  51. begin
  52. { push high }
  53. case p^.left^.resulttype^.deftype of
  54. arraydef : begin
  55. if is_open_array(p^.left^.resulttype) then
  56. begin
  57. r:=new_reference(highframepointer,highoffset+4);
  58. len:=-1;
  59. end
  60. else
  61. len:=parraydef(p^.left^.resulttype)^.highrange-
  62. parraydef(p^.left^.resulttype)^.lowrange
  63. end;
  64. stringdef : begin
  65. if p^.left^.treetype=stringconstn then
  66. len:=str_length(p^.left)
  67. else
  68. begin
  69. href:=p^.left^.location.reference;
  70. dec(href.offset);
  71. hreg:=reg32toreg8(getregister32);
  72. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_B,newreference(href),hreg)));
  73. emit_to_reg32(hreg);
  74. len:=-2;
  75. end;
  76. end;
  77. else
  78. len:=0;
  79. end;
  80. { Push from the reference? }
  81. if len=-1 then
  82. begin
  83. if inlined then
  84. begin
  85. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
  86. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  87. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  88. end
  89. else
  90. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,r)));
  91. end
  92. else
  93. { Push from a register? }
  94. if len=-2 then
  95. begin
  96. if inlined then
  97. begin
  98. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  99. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,hreg,r)));
  100. end
  101. else
  102. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,hreg)));
  103. ungetregister32(hreg);
  104. end
  105. else
  106. { Push direct value }
  107. begin
  108. if inlined then
  109. begin
  110. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  111. exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_L,len,r)));
  112. end
  113. else
  114. push_int(len);
  115. end;
  116. inc(pushedparasize,4);
  117. end;
  118. end;
  119. var
  120. size : longint;
  121. stackref : treference;
  122. otlabel,hlabel,oflabel : plabel;
  123. { temporary variables: }
  124. tempdeftype : tdeftype;
  125. tempreference : treference;
  126. r : preference;
  127. s : topsize;
  128. op : tasmop;
  129. begin
  130. { push from left to right if specified }
  131. if push_from_left_to_right and assigned(p^.right) then
  132. secondcallparan(p^.right,defcoll^.next,push_from_left_to_right,inlined,para_offset);
  133. otlabel:=truelabel;
  134. oflabel:=falselabel;
  135. getlabel(truelabel);
  136. getlabel(falselabel);
  137. secondpass(p^.left);
  138. { in codegen.handleread.. defcoll^.data is set to nil }
  139. if assigned(defcoll^.data) and
  140. (defcoll^.data^.deftype=formaldef) then
  141. begin
  142. { allow @var }
  143. inc(pushedparasize,4);
  144. if p^.left^.treetype=addrn then
  145. begin
  146. { always a register }
  147. if inlined then
  148. begin
  149. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  150. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
  151. p^.left^.location.register,r)));
  152. end
  153. else
  154. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
  155. ungetregister32(p^.left^.location.register);
  156. end
  157. else
  158. begin
  159. if not(p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
  160. CGMessage(type_e_mismatch)
  161. else
  162. begin
  163. if inlined then
  164. begin
  165. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  166. newreference(p^.left^.location.reference),R_EDI)));
  167. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  168. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  169. end
  170. else
  171. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  172. del_reference(p^.left^.location.reference);
  173. end;
  174. end;
  175. end
  176. { handle call by reference parameter }
  177. else if (defcoll^.paratyp=vs_var) then
  178. begin
  179. if (p^.left^.location.loc<>LOC_REFERENCE) then
  180. CGMessage(cg_e_var_must_be_reference);
  181. maybe_push_open_array_high;
  182. inc(pushedparasize,4);
  183. if inlined then
  184. begin
  185. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  186. newreference(p^.left^.location.reference),R_EDI)));
  187. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  188. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  189. end
  190. else
  191. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  192. del_reference(p^.left^.location.reference);
  193. end
  194. else
  195. begin
  196. tempdeftype:=p^.resulttype^.deftype;
  197. if tempdeftype=filedef then
  198. CGMessage(cg_e_file_must_call_by_reference);
  199. if (defcoll^.paratyp=vs_const) and
  200. dont_copy_const_param(p^.resulttype) then
  201. begin
  202. maybe_push_open_array_high;
  203. inc(pushedparasize,4);
  204. if inlined then
  205. begin
  206. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  207. newreference(p^.left^.location.reference),R_EDI)));
  208. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  209. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
  210. R_EDI,r)));
  211. end
  212. else
  213. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  214. del_reference(p^.left^.location.reference);
  215. end
  216. else
  217. case p^.left^.location.loc of
  218. LOC_REGISTER,
  219. LOC_CREGISTER:
  220. begin
  221. case p^.left^.location.register of
  222. R_EAX,R_EBX,R_ECX,R_EDX,R_ESI,
  223. R_EDI,R_ESP,R_EBP :
  224. begin
  225. inc(pushedparasize,4);
  226. if inlined then
  227. begin
  228. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  229. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
  230. p^.left^.location.register,r)));
  231. end
  232. else
  233. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
  234. ungetregister32(p^.left^.location.register);
  235. end;
  236. R_AX,R_BX,R_CX,R_DX,R_SI,R_DI:
  237. begin
  238. inc(pushedparasize,2);
  239. if inlined then
  240. begin
  241. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  242. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_W,
  243. p^.left^.location.register,r)));
  244. end
  245. else
  246. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_W,p^.left^.location.register)));
  247. ungetregister32(reg16toreg32(p^.left^.location.register));
  248. end;
  249. R_AL,R_BL,R_CL,R_DL:
  250. begin
  251. inc(pushedparasize,2);
  252. { we must push always 16 bit }
  253. if inlined then
  254. begin
  255. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  256. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
  257. reg8toreg16(p^.left^.location.register),r)));
  258. end
  259. else
  260. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_W,
  261. reg8toreg16(p^.left^.location.register))));
  262. ungetregister32(reg8toreg32(p^.left^.location.register));
  263. end;
  264. end;
  265. end;
  266. LOC_FPU:
  267. begin
  268. size:=pfloatdef(p^.left^.resulttype)^.size;
  269. inc(pushedparasize,size); { must be before for inlined }
  270. if not inlined then
  271. exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,S_L,size,R_ESP)));
  272. r:=new_reference(R_ESP,0);
  273. floatstoreops(pfloatdef(p^.left^.resulttype)^.typ,op,s);
  274. { this is the easiest case for inlined !! }
  275. if inlined then
  276. begin
  277. r^.base:=procinfo.framepointer;
  278. r^.offset:=para_offset-pushedparasize;
  279. end;
  280. exprasmlist^.concat(new(pai386,op_ref(op,s,r)));
  281. end;
  282. LOC_REFERENCE,LOC_MEM:
  283. begin
  284. tempreference:=p^.left^.location.reference;
  285. del_reference(p^.left^.location.reference);
  286. case p^.resulttype^.deftype of
  287. enumdef,
  288. orddef :
  289. begin
  290. case p^.resulttype^.size of
  291. 4 : begin
  292. inc(pushedparasize,4);
  293. if inlined then
  294. begin
  295. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  296. newreference(tempreference),R_EDI)));
  297. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  298. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  299. end
  300. else
  301. emit_push_mem(tempreference);
  302. end;
  303. 1,2 : begin
  304. inc(pushedparasize,2);
  305. if inlined then
  306. begin
  307. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_W,
  308. newreference(tempreference),R_DI)));
  309. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  310. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_W,R_DI,r)));
  311. end
  312. else
  313. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_W,
  314. newreference(tempreference))));
  315. end;
  316. else
  317. internalerror(234231);
  318. end;
  319. end;
  320. floatdef :
  321. begin
  322. case pfloatdef(p^.resulttype)^.typ of
  323. f32bit,
  324. s32real :
  325. begin
  326. inc(pushedparasize,4);
  327. if inlined then
  328. begin
  329. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  330. newreference(tempreference),R_EDI)));
  331. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  332. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  333. end
  334. else
  335. emit_push_mem(tempreference);
  336. end;
  337. s64real,
  338. s64bit :
  339. begin
  340. inc(pushedparasize,4);
  341. inc(tempreference.offset,4);
  342. if inlined then
  343. begin
  344. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  345. newreference(tempreference),R_EDI)));
  346. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  347. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  348. end
  349. else
  350. emit_push_mem(tempreference);
  351. inc(pushedparasize,4);
  352. dec(tempreference.offset,4);
  353. if inlined then
  354. begin
  355. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  356. newreference(tempreference),R_EDI)));
  357. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  358. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  359. end
  360. else
  361. emit_push_mem(tempreference);
  362. end;
  363. s80real :
  364. begin
  365. inc(pushedparasize,4);
  366. inc(tempreference.offset,6);
  367. if inlined then
  368. begin
  369. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  370. newreference(tempreference),R_EDI)));
  371. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  372. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  373. end
  374. else
  375. emit_push_mem(tempreference);
  376. dec(tempreference.offset,4);
  377. inc(pushedparasize,4);
  378. if inlined then
  379. begin
  380. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  381. newreference(tempreference),R_EDI)));
  382. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  383. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  384. end
  385. else
  386. emit_push_mem(tempreference);
  387. dec(tempreference.offset,2);
  388. inc(pushedparasize,2);
  389. if inlined then
  390. begin
  391. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_W,
  392. newreference(tempreference),R_DI)));
  393. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  394. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_W,R_DI,r)));
  395. end
  396. else
  397. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_W,
  398. newreference(tempreference))));
  399. end;
  400. end;
  401. end;
  402. pointerdef,procvardef,
  403. classrefdef:
  404. begin
  405. inc(pushedparasize,4);
  406. if inlined then
  407. begin
  408. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  409. newreference(tempreference),R_EDI)));
  410. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  411. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  412. end
  413. else
  414. emit_push_mem(tempreference);
  415. end;
  416. arraydef,recorddef,stringdef,setdef,objectdef :
  417. begin
  418. { 32 bit type set ? }
  419. if is_widestring(p^.resulttype) or
  420. is_ansistring(p^.resulttype) or
  421. ((p^.resulttype^.deftype=setdef) and
  422. (psetdef(p^.resulttype)^.settype=smallset)) then
  423. begin
  424. inc(pushedparasize,4);
  425. if inlined then
  426. begin
  427. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  428. concatcopy(tempreference,r^,4,false);
  429. end
  430. else
  431. emit_push_mem(tempreference);
  432. end
  433. { call by value open array ? }
  434. else
  435. if (p^.resulttype^.deftype=arraydef) and
  436. assigned(defcoll^.data) and
  437. is_open_array(defcoll^.data) then
  438. begin
  439. { first, push high }
  440. maybe_push_open_array_high;
  441. inc(pushedparasize,4);
  442. if inlined then
  443. begin
  444. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  445. newreference(p^.left^.location.reference),R_EDI)));
  446. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  447. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
  448. R_EDI,r)));
  449. end
  450. else
  451. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  452. end
  453. else
  454. begin
  455. size:=p^.resulttype^.size;
  456. { Word Alignment }
  457. if Odd(size) then
  458. inc(size);
  459. { create stack space }
  460. if not inlined then
  461. exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,S_L,size,R_ESP)));
  462. inc(pushedparasize,size);
  463. { create stack reference }
  464. stackref.symbol := nil;
  465. if not inlined then
  466. begin
  467. clear_reference(stackref);
  468. stackref.base:=R_ESP;
  469. end
  470. else
  471. begin
  472. clear_reference(stackref);
  473. stackref.base:=procinfo.framepointer;
  474. stackref.offset:=para_offset-pushedparasize;
  475. end;
  476. { generate copy }
  477. if is_shortstring(p^.resulttype) then
  478. begin
  479. copystring(stackref,p^.left^.location.reference,
  480. pstringdef(p^.resulttype)^.len);
  481. end
  482. else
  483. begin
  484. concatcopy(p^.left^.location.reference,
  485. stackref,p^.resulttype^.size,true);
  486. end;
  487. end;
  488. end;
  489. else
  490. CGMessage(cg_e_illegal_expression);
  491. end;
  492. end;
  493. LOC_JUMP:
  494. begin
  495. getlabel(hlabel);
  496. inc(pushedparasize,2);
  497. emitl(A_LABEL,truelabel);
  498. if inlined then
  499. begin
  500. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  501. exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_W,1,r)));
  502. end
  503. else
  504. exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_W,1)));
  505. emitl(A_JMP,hlabel);
  506. emitl(A_LABEL,falselabel);
  507. if inlined then
  508. begin
  509. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  510. exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_W,0,r)));
  511. end
  512. else
  513. exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_W,0)));
  514. emitl(A_LABEL,hlabel);
  515. end;
  516. LOC_FLAGS:
  517. begin
  518. if not(R_EAX in unused) then
  519. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,R_EAX,R_EDI)));
  520. { clear full EAX is faster }
  521. { but dont you set the equal flag ? }
  522. {exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_EAX,R_EAX)));}
  523. exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.left^.location.resflags],S_B,
  524. R_AL)));
  525. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BW,R_AL,R_AX)));
  526. {exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_EAX,R_EAX)));}
  527. inc(pushedparasize,2);
  528. if inlined then
  529. begin
  530. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  531. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_W,
  532. R_AX,r)));
  533. end
  534. else
  535. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_W,R_AX)));
  536. { this is also false !!!
  537. if not(R_EAX in unused) then
  538. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,R_EAX,R_EDI)));}
  539. if not(R_EAX in unused) then
  540. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,R_EDI,R_EAX)));
  541. end;
  542. {$ifdef SUPPORT_MMX}
  543. LOC_MMXREGISTER,
  544. LOC_CMMXREGISTER:
  545. begin
  546. inc(pushedparasize,8); { was missing !!! (PM) }
  547. exprasmlist^.concat(new(pai386,op_const_reg(
  548. A_SUB,S_L,8,R_ESP)));
  549. if inlined then
  550. begin
  551. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  552. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOVQ,S_NO,
  553. p^.left^.location.register,r)));
  554. end
  555. else
  556. begin
  557. r:=new_reference(R_ESP,0);
  558. exprasmlist^.concat(new(pai386,op_reg_ref(
  559. A_MOVQ,S_NO,p^.left^.location.register,r)));
  560. end;
  561. end;
  562. {$endif SUPPORT_MMX}
  563. end;
  564. end;
  565. freelabel(truelabel);
  566. freelabel(falselabel);
  567. truelabel:=otlabel;
  568. falselabel:=oflabel;
  569. { push from right to left }
  570. if not push_from_left_to_right and assigned(p^.right) then
  571. secondcallparan(p^.right,defcoll^.next,push_from_left_to_right,inlined,para_offset);
  572. end;
  573. {*****************************************************************************
  574. SecondCallN
  575. *****************************************************************************}
  576. procedure secondcalln(var p : ptree);
  577. var
  578. unusedregisters : tregisterset;
  579. pushed : tpushed;
  580. funcretref : treference;
  581. hregister : tregister;
  582. oldpushedparasize : longint;
  583. { true if ESI must be loaded again after the subroutine }
  584. loadesi : boolean;
  585. { true if a virtual method must be called directly }
  586. no_virtual_call : boolean;
  587. { true if we produce a con- or destrutor in a call }
  588. is_con_or_destructor : boolean;
  589. { true if a constructor is called again }
  590. extended_new : boolean;
  591. { adress returned from an I/O-error }
  592. iolabel : plabel;
  593. { lexlevel count }
  594. i : longint;
  595. { help reference pointer }
  596. r : preference;
  597. hp,
  598. pp,params : ptree;
  599. inlined : boolean;
  600. inlinecode : ptree;
  601. para_offset : longint;
  602. { instruction for alignement correction }
  603. { corr : pai386;}
  604. { we must pop this size also after !! }
  605. { must_pop : boolean; }
  606. pop_size : longint;
  607. label
  608. dont_call;
  609. begin
  610. extended_new:=false;
  611. iolabel:=nil;
  612. inlinecode:=nil;
  613. inlined:=false;
  614. loadesi:=true;
  615. no_virtual_call:=false;
  616. unusedregisters:=unused;
  617. if not assigned(p^.procdefinition) then
  618. exit;
  619. if (p^.procdefinition^.options and poinline)<>0 then
  620. begin
  621. inlined:=true;
  622. inlinecode:=p^.right;
  623. { set it to the same lexical level }
  624. p^.procdefinition^.parast^.symtablelevel:=
  625. aktprocsym^.definition^.parast^.symtablelevel;
  626. if assigned(p^.left) then
  627. inlinecode^.para_offset:=
  628. gettempofsizepersistant(inlinecode^.para_size);
  629. p^.procdefinition^.parast^.call_offset:=
  630. inlinecode^.para_offset;
  631. {$ifdef extdebug}
  632. Comment(V_debug,
  633. 'inlined parasymtable is at offset '
  634. +tostr(p^.procdefinition^.parast^.call_offset));
  635. exprasmlist^.concat(new(pai_asm_comment,init(
  636. strpnew('inlined parasymtable is at offset '
  637. +tostr(p^.procdefinition^.parast^.call_offset)))));
  638. {$endif extdebug}
  639. p^.right:=nil;
  640. { disable further inlining of the same proc
  641. in the args }
  642. p^.procdefinition^.options:=p^.procdefinition^.options and (not poinline);
  643. end;
  644. { only if no proc var }
  645. if not(assigned(p^.right)) then
  646. is_con_or_destructor:=((p^.procdefinition^.options and poconstructor)<>0)
  647. or ((p^.procdefinition^.options and podestructor)<>0);
  648. { proc variables destroy all registers }
  649. if (p^.right=nil) and
  650. { virtual methods too }
  651. ((p^.procdefinition^.options and povirtualmethod)=0) then
  652. begin
  653. if ((p^.procdefinition^.options and poiocheck)<>0) and
  654. (cs_check_io in aktlocalswitches) then
  655. begin
  656. getlabel(iolabel);
  657. emitl(A_LABEL,iolabel);
  658. end
  659. else
  660. iolabel:=nil;
  661. { save all used registers }
  662. pushusedregisters(pushed,p^.procdefinition^.usedregisters);
  663. { give used registers through }
  664. usedinproc:=usedinproc or p^.procdefinition^.usedregisters;
  665. end
  666. else
  667. begin
  668. pushusedregisters(pushed,$ff);
  669. usedinproc:=$ff;
  670. { no IO check for methods and procedure variables }
  671. iolabel:=nil;
  672. end;
  673. { generate the code for the parameter and push them }
  674. oldpushedparasize:=pushedparasize;
  675. pushedparasize:=0;
  676. pop_size:=0;
  677. if (not inlined) then
  678. begin
  679. { Old pushedsize aligned on 4 ? }
  680. i:=oldpushedparasize and 3;
  681. if i>0 then
  682. inc(pop_size,4-i);
  683. { This parasize aligned on 4 ? }
  684. i:=p^.procdefinition^.para_size and 3;
  685. if i>0 then
  686. inc(pop_size,4-i);
  687. { insert the opcode and update pushedparasize }
  688. if pop_size>0 then
  689. begin
  690. inc(pushedparasize,pop_size);
  691. exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,S_L,pop_size,R_ESP)));
  692. end;
  693. end;
  694. if (p^.resulttype<>pdef(voiddef)) and
  695. ret_in_param(p^.resulttype) then
  696. begin
  697. funcretref.symbol:=nil;
  698. {$ifdef test_dest_loc}
  699. if dest_loc_known and (dest_loc_tree=p) and
  700. (dest_loc.loc in [LOC_REFERENCE,LOC_MEM]) then
  701. begin
  702. funcretref:=dest_loc.reference;
  703. if assigned(dest_loc.reference.symbol) then
  704. funcretref.symbol:=stringdup(dest_loc.reference.symbol^);
  705. in_dest_loc:=true;
  706. end
  707. else
  708. {$endif test_dest_loc}
  709. if inlined then
  710. begin
  711. reset_reference(funcretref);
  712. funcretref.offset:=gettempofsizepersistant(p^.procdefinition^.retdef^.size);
  713. funcretref.base:=procinfo.framepointer;
  714. end
  715. else
  716. gettempofsizereference(p^.procdefinition^.retdef^.size,funcretref);
  717. end;
  718. if assigned(p^.left) then
  719. begin
  720. { be found elsewhere }
  721. if inlined then
  722. para_offset:=p^.procdefinition^.parast^.call_offset+
  723. p^.procdefinition^.parast^.datasize
  724. else
  725. para_offset:=0;
  726. if assigned(p^.right) then
  727. secondcallparan(p^.left,pprocvardef(p^.right^.resulttype)^.para1,
  728. (p^.procdefinition^.options and poleftright)<>0,inlined,para_offset)
  729. else
  730. secondcallparan(p^.left,p^.procdefinition^.para1,
  731. (p^.procdefinition^.options and poleftright)<>0,inlined,para_offset);
  732. end;
  733. params:=p^.left;
  734. p^.left:=nil;
  735. if inlined then
  736. inlinecode^.retoffset:=gettempofsizepersistant(4);
  737. if ret_in_param(p^.resulttype) then
  738. begin
  739. inc(pushedparasize,4);
  740. if inlined then
  741. begin
  742. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  743. newreference(funcretref),R_EDI)));
  744. r:=new_reference(procinfo.framepointer,inlinecode^.retoffset);
  745. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
  746. R_EDI,r)));
  747. end
  748. else
  749. emitpushreferenceaddr(exprasmlist,funcretref);
  750. end;
  751. { procedure variable ? }
  752. if (p^.right=nil) then
  753. begin
  754. { overloaded operator have no symtable }
  755. { push self }
  756. if assigned(p^.symtable) and
  757. (p^.symtable^.symtabletype=withsymtable) then
  758. begin
  759. { dirty trick to avoid the secondcall below }
  760. p^.methodpointer:=genzeronode(callparan);
  761. p^.methodpointer^.location.loc:=LOC_REGISTER;
  762. p^.methodpointer^.location.register:=R_ESI;
  763. p^.methodpointer^.resulttype:=p^.symtable^.defowner;
  764. { change dispose type !! }
  765. p^.disposetyp:=dt_mbleft_and_method;
  766. { make a reference }
  767. new(r);
  768. reset_reference(r^);
  769. r^.offset:=p^.symtable^.datasize;
  770. r^.base:=procinfo.framepointer;
  771. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
  772. end;
  773. { push self }
  774. if assigned(p^.symtable) and
  775. ((p^.symtable^.symtabletype=objectsymtable) or
  776. (p^.symtable^.symtabletype=withsymtable)) then
  777. begin
  778. if assigned(p^.methodpointer) then
  779. begin
  780. {
  781. if p^.methodpointer^.resulttype=classrefdef then
  782. begin
  783. two possibilities:
  784. 1. constructor
  785. 2. class method
  786. end
  787. else }
  788. begin
  789. case p^.methodpointer^.treetype of
  790. typen:
  791. begin
  792. { direct call to inherited method }
  793. if (p^.procdefinition^.options and poabstractmethod)<>0 then
  794. begin
  795. CGMessage(cg_e_cant_call_abstract_method);
  796. goto dont_call;
  797. end;
  798. { generate no virtual call }
  799. no_virtual_call:=true;
  800. if (p^.symtableprocentry^.properties and sp_static)<>0 then
  801. begin
  802. { well lets put the VMT address directly into ESI }
  803. { it is kind of dirty but that is the simplest }
  804. { way to accept virtual static functions (PM) }
  805. loadesi:=true;
  806. exprasmlist^.concat(new(pai386,op_csymbol_reg(A_MOV,S_L,
  807. newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0),R_ESI)));
  808. maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
  809. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
  810. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  811. end
  812. else
  813. { this is a member call, so ESI isn't modfied }
  814. loadesi:=false;
  815. if not(is_con_or_destructor and
  816. pobjectdef(p^.methodpointer^.resulttype)^.isclass and
  817. assigned(aktprocsym) and
  818. ((aktprocsym^.definition^.options and
  819. (poconstructor or podestructor))<>0)) then
  820. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  821. { if an inherited con- or destructor should be }
  822. { called in a con- or destructor then a warning }
  823. { will be made }
  824. { con- and destructors need a pointer to the vmt }
  825. if is_con_or_destructor and
  826. not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) and
  827. assigned(aktprocsym) then
  828. begin
  829. if not ((aktprocsym^.definition^.options
  830. and (poconstructor or podestructor))<>0) then
  831. CGMessage(cg_w_member_cd_call_from_method);
  832. end;
  833. if is_con_or_destructor then
  834. push_int(0)
  835. end;
  836. hnewn:
  837. begin
  838. { extended syntax of new }
  839. { ESI must be zero }
  840. exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_ESI,R_ESI)));
  841. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  842. { insert the vmt }
  843. exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
  844. newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
  845. maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
  846. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
  847. extended_new:=true;
  848. end;
  849. hdisposen:
  850. begin
  851. secondpass(p^.methodpointer);
  852. { destructor with extended syntax called from dispose }
  853. { hdisposen always deliver LOC_REFERENCE }
  854. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  855. newreference(p^.methodpointer^.location.reference),R_ESI)));
  856. del_reference(p^.methodpointer^.location.reference);
  857. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  858. exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
  859. newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
  860. maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
  861. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
  862. end;
  863. else
  864. begin
  865. { call to an instance member }
  866. if (p^.symtable^.symtabletype<>withsymtable) then
  867. begin
  868. secondpass(p^.methodpointer);
  869. case p^.methodpointer^.location.loc of
  870. LOC_CREGISTER,
  871. LOC_REGISTER:
  872. begin
  873. ungetregister32(p^.methodpointer^.location.register);
  874. emit_reg_reg(A_MOV,S_L,p^.methodpointer^.location.register,R_ESI);
  875. end;
  876. else
  877. begin
  878. if (p^.methodpointer^.resulttype^.deftype=classrefdef) or
  879. ((p^.methodpointer^.resulttype^.deftype=objectdef) and
  880. pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  881. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  882. newreference(p^.methodpointer^.location.reference),R_ESI)))
  883. else
  884. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  885. newreference(p^.methodpointer^.location.reference),R_ESI)));
  886. del_reference(p^.methodpointer^.location.reference);
  887. end;
  888. end;
  889. end;
  890. { when calling a class method, we have
  891. to load ESI with the VMT !
  892. But that's wrong, if we call a class method via self
  893. }
  894. if ((p^.procdefinition^.options and poclassmethod)<>0)
  895. and not(p^.methodpointer^.resulttype^.deftype=classrefdef) then
  896. begin
  897. { class method needs current VMT }
  898. new(r);
  899. reset_reference(r^);
  900. r^.base:=R_ESI;
  901. r^.offset:= p^.procdefinition^._class^.vmt_offset;
  902. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
  903. end;
  904. { direct call to class constructor, don't allocate memory }
  905. if is_con_or_destructor and
  906. (p^.methodpointer^.resulttype^.deftype=objectdef) and
  907. (pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  908. exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,0)))
  909. else
  910. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  911. if is_con_or_destructor then
  912. begin
  913. { classes don't get a VMT pointer pushed }
  914. if (p^.methodpointer^.resulttype^.deftype=objectdef) and
  915. not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  916. begin
  917. if ((p^.procdefinition^.options and poconstructor)<>0) then
  918. begin
  919. { it's no bad idea, to insert the VMT }
  920. exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
  921. newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,
  922. 0))));
  923. maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
  924. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
  925. end
  926. { destructors haven't to dispose the instance, if this is }
  927. { a direct call }
  928. else
  929. push_int(0);
  930. end;
  931. end;
  932. end;
  933. end;
  934. end;
  935. end
  936. else
  937. begin
  938. if ((p^.procdefinition^.options and poclassmethod)<>0) and
  939. not(
  940. assigned(aktprocsym) and
  941. ((aktprocsym^.definition^.options and poclassmethod)<>0)
  942. ) then
  943. begin
  944. { class method needs current VMT }
  945. new(r);
  946. reset_reference(r^);
  947. r^.base:=R_ESI;
  948. r^.offset:= p^.procdefinition^._class^.vmt_offset;
  949. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
  950. end
  951. else
  952. begin
  953. { member call, ESI isn't modified }
  954. loadesi:=false;
  955. end;
  956. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  957. { but a con- or destructor here would probably almost }
  958. { always be placed wrong }
  959. if is_con_or_destructor then
  960. begin
  961. CGMessage(cg_w_member_cd_call_from_method);
  962. push_int(0);
  963. end;
  964. end;
  965. end;
  966. { push base pointer ?}
  967. if (lexlevel>1) and assigned(pprocdef(p^.procdefinition)^.parast) and
  968. ((p^.procdefinition^.parast^.symtablelevel)>2) then
  969. begin
  970. { if we call a nested function in a method, we must }
  971. { push also SELF! }
  972. { THAT'S NOT TRUE, we have to load ESI via frame pointer }
  973. { access }
  974. {
  975. begin
  976. loadesi:=false;
  977. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  978. end;
  979. }
  980. if lexlevel=(p^.procdefinition^.parast^.symtablelevel) then
  981. begin
  982. new(r);
  983. reset_reference(r^);
  984. r^.offset:=procinfo.framepointer_offset;
  985. r^.base:=procinfo.framepointer;
  986. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,r)))
  987. end
  988. { this is only true if the difference is one !!
  989. but it cannot be more !! }
  990. else if (lexlevel=p^.procdefinition^.parast^.symtablelevel-1) then
  991. begin
  992. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,procinfo.framepointer)))
  993. end
  994. else if (lexlevel>p^.procdefinition^.parast^.symtablelevel) then
  995. begin
  996. hregister:=getregister32;
  997. new(r);
  998. reset_reference(r^);
  999. r^.offset:=procinfo.framepointer_offset;
  1000. r^.base:=procinfo.framepointer;
  1001. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,hregister)));
  1002. for i:=(p^.procdefinition^.parast^.symtablelevel) to lexlevel-1 do
  1003. begin
  1004. new(r);
  1005. reset_reference(r^);
  1006. {we should get the correct frame_pointer_offset at each level
  1007. how can we do this !!! }
  1008. r^.offset:=procinfo.framepointer_offset;
  1009. r^.base:=hregister;
  1010. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,hregister)));
  1011. end;
  1012. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,hregister)));
  1013. ungetregister32(hregister);
  1014. end
  1015. else
  1016. internalerror(25000);
  1017. end;
  1018. if ((p^.procdefinition^.options and povirtualmethod)<>0) and
  1019. not(no_virtual_call) then
  1020. begin
  1021. { static functions contain the vmt_address in ESI }
  1022. { also class methods }
  1023. if assigned(aktprocsym) then
  1024. begin
  1025. if ((aktprocsym^.properties and sp_static)<>0) or
  1026. ((aktprocsym^.definition^.options and poclassmethod)<>0) or
  1027. ((p^.procdefinition^.options and postaticmethod)<>0) or
  1028. ((p^.procdefinition^.options and poconstructor)<>0) or
  1029. { ESI is loaded earlier }
  1030. ((p^.procdefinition^.options and poclassmethod)<>0)then
  1031. begin
  1032. new(r);
  1033. reset_reference(r^);
  1034. r^.base:=R_ESI;
  1035. end
  1036. else
  1037. begin
  1038. new(r);
  1039. reset_reference(r^);
  1040. r^.base:=R_ESI;
  1041. { this is one point where we need vmt_offset (PM) }
  1042. r^.offset:= p^.procdefinition^._class^.vmt_offset;
  1043. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
  1044. new(r);
  1045. reset_reference(r^);
  1046. r^.base:=R_EDI;
  1047. end;
  1048. end
  1049. else
  1050. { aktprocsym should be assigned, also in main program }
  1051. internalerror(12345);
  1052. {
  1053. begin
  1054. new(r);
  1055. reset_reference(r^);
  1056. r^.base:=R_ESI;
  1057. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
  1058. new(r);
  1059. reset_reference(r^);
  1060. r^.base:=R_EDI;
  1061. end;
  1062. }
  1063. if p^.procdefinition^.extnumber=-1 then
  1064. internalerror($Da);
  1065. r^.offset:=p^.procdefinition^.extnumber*4+12;
  1066. if (cs_check_range in aktlocalswitches) then
  1067. begin
  1068. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,r^.base)));
  1069. emitcall('FPC_CHECK_OBJECT',true);
  1070. end;
  1071. exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,r)));
  1072. end
  1073. else if not inlined then
  1074. emitcall(p^.procdefinition^.mangledname,
  1075. (p^.symtableproc^.symtabletype=unitsymtable) or
  1076. ((p^.symtableproc^.symtabletype=objectsymtable) and
  1077. (pobjectdef(p^.symtableproc^.defowner)^.owner^.symtabletype=unitsymtable)))
  1078. else { inlined proc }
  1079. { inlined code is in inlinecode }
  1080. begin
  1081. secondpass(inlinecode);
  1082. { set poinline again }
  1083. p^.procdefinition^.options:=p^.procdefinition^.options or poinline;
  1084. { free the args }
  1085. ungetpersistanttemp(p^.procdefinition^.parast^.call_offset,
  1086. p^.procdefinition^.parast^.datasize);
  1087. end;
  1088. end
  1089. else
  1090. { now procedure variable case }
  1091. begin
  1092. secondpass(p^.right);
  1093. { method pointer ? }
  1094. if (p^.procdefinition^.options and pomethodpointer)<>0 then
  1095. begin
  1096. { method pointer can't be in a register }
  1097. inc(p^.right^.location.reference.offset,4);
  1098. { push self pointer }
  1099. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,newreference(p^.right^.location.reference))));
  1100. del_reference(p^.right^.location.reference);
  1101. dec(p^.right^.location.reference.offset,4);
  1102. end;
  1103. case p^.right^.location.loc of
  1104. LOC_REGISTER,LOC_CREGISTER:
  1105. begin
  1106. exprasmlist^.concat(new(pai386,op_reg(A_CALL,S_NO,p^.right^.location.register)));
  1107. ungetregister32(p^.right^.location.register);
  1108. end
  1109. else
  1110. exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,newreference(p^.right^.location.reference))));
  1111. del_reference(p^.right^.location.reference);
  1112. end;
  1113. end;
  1114. { this was only for normal functions
  1115. displaced here so we also get
  1116. it to work for procvars PM }
  1117. if (not inlined) and ((p^.procdefinition^.options and poclearstack)<>0) then
  1118. begin
  1119. { consider the alignment with the rest (PM) }
  1120. inc(pushedparasize,pop_size);
  1121. pop_size:=0;
  1122. { better than an add on all processors }
  1123. if pushedparasize=4 then
  1124. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)))
  1125. { the pentium has two pipes and pop reg is pairable }
  1126. { but the registers must be different! }
  1127. else if (pushedparasize=8) and
  1128. not(cs_littlesize in aktglobalswitches) and
  1129. (aktoptprocessor=ClassP5) and
  1130. (procinfo._class=nil) then
  1131. begin
  1132. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
  1133. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_ESI)));
  1134. end
  1135. else exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,pushedparasize,R_ESP)));
  1136. end;
  1137. dont_call:
  1138. pushedparasize:=oldpushedparasize;
  1139. unused:=unusedregisters;
  1140. { handle function results }
  1141. { structured results are easy to handle.... }
  1142. { needed also when result_no_used !! }
  1143. if (p^.resulttype<>pdef(voiddef)) and ret_in_param(p^.resulttype) then
  1144. begin
  1145. p^.location.loc:=LOC_MEM;
  1146. stringdispose(p^.location.reference.symbol);
  1147. p^.location.reference:=funcretref;
  1148. end;
  1149. if (p^.resulttype<>pdef(voiddef)) and p^.return_value_used then
  1150. begin
  1151. { a contructor could be a function with boolean result }
  1152. if (p^.right=nil) and
  1153. ((p^.procdefinition^.options and poconstructor)<>0) and
  1154. { quick'n'dirty check if it is a class or an object }
  1155. (p^.resulttype^.deftype=orddef) then
  1156. begin
  1157. p^.location.loc:=LOC_FLAGS;
  1158. p^.location.resflags:=F_NE;
  1159. if extended_new then
  1160. begin
  1161. {$ifdef test_dest_loc}
  1162. if dest_loc_known and (dest_loc_tree=p) then
  1163. mov_reg_to_dest(p,S_L,R_EAX)
  1164. else
  1165. {$endif test_dest_loc}
  1166. begin
  1167. hregister:=getregister32;
  1168. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1169. p^.location.register:=hregister;
  1170. end;
  1171. end;
  1172. end
  1173. { structed results are easy to handle.... }
  1174. else if ret_in_param(p^.resulttype) then
  1175. begin
  1176. {p^.location.loc:=LOC_MEM;
  1177. stringdispose(p^.location.reference.symbol);
  1178. p^.location.reference:=funcretref;
  1179. already done above (PM) }
  1180. end
  1181. else
  1182. begin
  1183. if (p^.resulttype^.deftype=orddef) then
  1184. begin
  1185. p^.location.loc:=LOC_REGISTER;
  1186. case porddef(p^.resulttype)^.typ of
  1187. s32bit,u32bit,bool32bit :
  1188. begin
  1189. {$ifdef test_dest_loc}
  1190. if dest_loc_known and (dest_loc_tree=p) then
  1191. mov_reg_to_dest(p,S_L,R_EAX)
  1192. else
  1193. {$endif test_dest_loc}
  1194. begin
  1195. hregister:=getregister32;
  1196. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1197. p^.location.register:=hregister;
  1198. end;
  1199. end;
  1200. uchar,u8bit,bool8bit,s8bit :
  1201. begin
  1202. {$ifdef test_dest_loc}
  1203. if dest_loc_known and (dest_loc_tree=p) then
  1204. mov_reg_to_dest(p,S_B,R_AL)
  1205. else
  1206. {$endif test_dest_loc}
  1207. begin
  1208. hregister:=getregister32;
  1209. emit_reg_reg(A_MOV,S_B,R_AL,reg32toreg8(hregister));
  1210. p^.location.register:=reg32toreg8(hregister);
  1211. end;
  1212. end;
  1213. s16bit,u16bit,bool16bit :
  1214. begin
  1215. {$ifdef test_dest_loc}
  1216. if dest_loc_known and (dest_loc_tree=p) then
  1217. mov_reg_to_dest(p,S_W,R_AX)
  1218. else
  1219. {$endif test_dest_loc}
  1220. begin
  1221. hregister:=getregister32;
  1222. emit_reg_reg(A_MOV,S_W,R_AX,reg32toreg16(hregister));
  1223. p^.location.register:=reg32toreg16(hregister);
  1224. end;
  1225. end;
  1226. else internalerror(7);
  1227. end
  1228. end
  1229. else if (p^.resulttype^.deftype=floatdef) then
  1230. case pfloatdef(p^.resulttype)^.typ of
  1231. f32bit : begin
  1232. p^.location.loc:=LOC_REGISTER;
  1233. {$ifdef test_dest_loc}
  1234. if dest_loc_known and (dest_loc_tree=p) then
  1235. mov_reg_to_dest(p,S_L,R_EAX)
  1236. else
  1237. {$endif test_dest_loc}
  1238. begin
  1239. hregister:=getregister32;
  1240. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1241. p^.location.register:=hregister;
  1242. end;
  1243. end;
  1244. else
  1245. p^.location.loc:=LOC_FPU;
  1246. end
  1247. else
  1248. begin
  1249. p^.location.loc:=LOC_REGISTER;
  1250. {$ifdef test_dest_loc}
  1251. if dest_loc_known and (dest_loc_tree=p) then
  1252. mov_reg_to_dest(p,S_L,R_EAX)
  1253. else
  1254. {$endif test_dest_loc}
  1255. begin
  1256. hregister:=getregister32;
  1257. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1258. p^.location.register:=hregister;
  1259. end;
  1260. end;
  1261. end;
  1262. end;
  1263. { perhaps i/o check ? }
  1264. if iolabel<>nil then
  1265. begin
  1266. exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,newcsymbol(lab2str(iolabel),0))));
  1267. emitcall('FPC_IOCHECK',true);
  1268. end;
  1269. if pop_size>0 then
  1270. exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,pop_size,R_ESP)));
  1271. { restore registers }
  1272. popusedregisters(pushed);
  1273. { at last, restore instance pointer (SELF) }
  1274. if loadesi then
  1275. maybe_loadesi;
  1276. pp:=params;
  1277. while assigned(pp) do
  1278. begin
  1279. if assigned(pp^.left) then
  1280. begin
  1281. if pp^.left^.location.loc in [LOC_REFERENCE,LOC_MEM] then
  1282. ungetiftemp(pp^.left^.location.reference);
  1283. { process also all nodes of an array of const }
  1284. if pp^.left^.treetype=arrayconstructn then
  1285. begin
  1286. if assigned(pp^.left^.left) then
  1287. begin
  1288. hp:=pp^.left;
  1289. while assigned(hp) do
  1290. begin
  1291. if hp^.left^.location.loc in [LOC_REFERENCE,LOC_MEM] then
  1292. ungetiftemp(hp^.left^.location.reference);
  1293. hp:=hp^.right;
  1294. end;
  1295. end;
  1296. end;
  1297. end;
  1298. pp:=pp^.right;
  1299. end;
  1300. if inlined then
  1301. ungetpersistanttemp(inlinecode^.retoffset,4);
  1302. disposetree(params);
  1303. { from now on the result can be freed normally }
  1304. if inlined and ret_in_param(p^.resulttype) then
  1305. persistanttemptonormal(funcretref.offset);
  1306. { if return value is not used }
  1307. if (not p^.return_value_used) and (p^.resulttype<>pdef(voiddef)) then
  1308. begin
  1309. if p^.location.loc in [LOC_MEM,LOC_REFERENCE] then
  1310. { release unused temp }
  1311. ungetiftemp(p^.location.reference)
  1312. else if p^.location.loc=LOC_FPU then
  1313. { release FPU stack }
  1314. exprasmlist^.concat(new(pai386,op_none(A_FDECSTP,S_NO)));
  1315. end;
  1316. end;
  1317. {*****************************************************************************
  1318. SecondProcInlineN
  1319. *****************************************************************************}
  1320. { implementation not complete yet }
  1321. var
  1322. addr_correction : longint;
  1323. procedure correct_address(p : psym);{$ifndef FPC}far;{$endif}
  1324. begin
  1325. if p^.typ=varsym then
  1326. begin
  1327. inc(pvarsym(p)^.address,addr_correction);
  1328. {$ifdef extdebug}
  1329. Comment(V_debug,pvarsym(p)^.name+' is at offset -'
  1330. +tostr(pvarsym(p)^.address));
  1331. exprasmlist^.concat(new(pai_asm_comment,init(
  1332. strpnew(pvarsym(p)^.name+' is at offset -'
  1333. +tostr(pvarsym(p)^.address)))));
  1334. {$endif extdebug}
  1335. end;
  1336. end;
  1337. procedure secondprocinline(var p : ptree);
  1338. var st : psymtable;
  1339. oldprocsym : pprocsym;
  1340. para_size : longint;
  1341. oldprocinfo : tprocinfo;
  1342. { just dummies for genentrycode }
  1343. nostackframe,make_global : boolean;
  1344. proc_names : tstringcontainer;
  1345. inlineentrycode,inlineexitcode : paasmoutput;
  1346. oldexitlabel,oldexit2label,oldquickexitlabel:Plabel;
  1347. begin
  1348. oldexitlabel:=aktexitlabel;
  1349. oldexit2label:=aktexit2label;
  1350. oldquickexitlabel:=quickexitlabel;
  1351. getlabel(aktexitlabel);
  1352. getlabel(aktexit2label);
  1353. oldprocsym:=aktprocsym;
  1354. oldprocinfo:=procinfo;
  1355. { set the return value }
  1356. procinfo.retdef:=p^.inlineprocdef^.retdef;
  1357. procinfo.retoffset:=p^.retoffset;
  1358. { arg space has been filled by the parent secondcall }
  1359. st:=p^.inlineprocdef^.localst;
  1360. { set it to the same lexical level }
  1361. st^.symtablelevel:=
  1362. oldprocsym^.definition^.localst^.symtablelevel;
  1363. if st^.datasize>0 then
  1364. st^.call_offset:=gettempofsizepersistant(st^.datasize);
  1365. {$ifdef extdebug}
  1366. Comment(V_debug,'local symtable is at offset '
  1367. +tostr(st^.call_offset));
  1368. exprasmlist^.concat(new(pai_asm_comment,init(
  1369. strpnew('local symtable is at offset '
  1370. +tostr(st^.call_offset)))));
  1371. {$endif extdebug}
  1372. addr_correction:=-st^.call_offset-st^.datasize;
  1373. st^.foreach(correct_address);
  1374. {$ifdef extdebug}
  1375. exprasmlist^.concat(new(pai_asm_comment,init('Start of inlined proc')));
  1376. {$endif extdebug}
  1377. { takes care of local data initialization }
  1378. inlineentrycode:=new(paasmoutput,init);
  1379. inlineexitcode:=new(paasmoutput,init);
  1380. proc_names.init;
  1381. para_size:=p^.para_size;
  1382. make_global:=false; { to avoid warning }
  1383. genentrycode(inlineentrycode,proc_names,make_global,0,para_size,nostackframe,true);
  1384. exprasmlist^.concatlist(inlineentrycode);
  1385. secondpass(p^.left);
  1386. genexitcode(inlineexitcode,0,false,true);
  1387. exprasmlist^.concatlist(inlineexitcode);
  1388. {$ifdef extdebug}
  1389. exprasmlist^.concat(new(pai_asm_comment,init('End of inlined proc')));
  1390. {$endif extdebug}
  1391. {we can free the local data now }
  1392. if st^.datasize>0 then
  1393. ungetpersistanttemp(st^.call_offset,st^.datasize);
  1394. { set the real address again }
  1395. addr_correction:=-addr_correction;
  1396. st^.foreach(correct_address);
  1397. aktprocsym:=oldprocsym;
  1398. freelabel(aktexitlabel);
  1399. freelabel(aktexit2label);
  1400. aktexitlabel:=oldexitlabel;
  1401. aktexit2label:=oldexit2label;
  1402. quickexitlabel:=oldquickexitlabel;
  1403. procinfo:=oldprocinfo;
  1404. end;
  1405. end.
  1406. {
  1407. $Log$
  1408. Revision 1.34 1998-10-09 08:56:22 pierre
  1409. * several memory leaks fixed
  1410. Revision 1.33 1998/10/06 17:16:39 pierre
  1411. * some memory leaks fixed (thanks to Peter for heaptrc !)
  1412. Revision 1.32 1998/10/01 09:22:52 peter
  1413. * fixed value openarray
  1414. * ungettemp of arrayconstruct
  1415. Revision 1.31 1998/09/28 16:57:15 pierre
  1416. * changed all length(p^.value_str^) into str_length(p)
  1417. to get it work with and without ansistrings
  1418. * changed sourcefiles field of tmodule to a pointer
  1419. Revision 1.30 1998/09/26 15:03:02 florian
  1420. * small problems with DOM and excpetions fixed (code generation
  1421. of raise was wrong and self was sometimes destroyed :()
  1422. Revision 1.29 1998/09/25 00:04:00 florian
  1423. * problems when calling class methods fixed
  1424. Revision 1.28 1998/09/24 14:27:37 peter
  1425. * some better support for openarray
  1426. Revision 1.27 1998/09/24 09:02:13 peter
  1427. * rewritten isconvertable to use case
  1428. * array of .. and single variable are compatible
  1429. Revision 1.26 1998/09/21 08:45:06 pierre
  1430. + added vmt_offset in tobjectdef.write for fututre use
  1431. (first steps to have objects without vmt if no virtual !!)
  1432. + added fpu_used field for tabstractprocdef :
  1433. sets this level to 2 if the functions return with value in FPU
  1434. (is then set to correct value at parsing of implementation)
  1435. THIS MIGHT refuse some code with FPU expression too complex
  1436. that were accepted before and even in some cases
  1437. that don't overflow in fact
  1438. ( like if f : float; is a forward that finally in implementation
  1439. only uses one fpu register !!)
  1440. Nevertheless I think that it will improve security on
  1441. FPU operations !!
  1442. * most other changes only for UseBrowser code
  1443. (added symtable references for record and objects)
  1444. local switch for refs to args and local of each function
  1445. (static symtable still missing)
  1446. UseBrowser still not stable and probably broken by
  1447. the definition hash array !!
  1448. Revision 1.25 1998/09/20 12:26:35 peter
  1449. * merged fixes
  1450. Revision 1.24 1998/09/17 09:42:10 peter
  1451. + pass_2 for cg386
  1452. * Message() -> CGMessage() for pass_1/pass_2
  1453. Revision 1.23 1998/09/14 10:43:45 peter
  1454. * all internal RTL functions start with FPC_
  1455. Revision 1.22.2.1 1998/09/20 12:20:06 peter
  1456. * Fixed stack not on 4 byte boundary when doing a call
  1457. Revision 1.22 1998/09/04 08:41:37 peter
  1458. * updated some error CGMessages
  1459. Revision 1.21 1998/09/01 12:47:57 peter
  1460. * use pdef^.size instead of orddef^.typ
  1461. Revision 1.20 1998/08/31 12:22:15 peter
  1462. * secondinline moved to cg386inl
  1463. Revision 1.19 1998/08/31 08:52:03 peter
  1464. * fixed error 10 with succ() and pref()
  1465. Revision 1.18 1998/08/20 21:36:38 peter
  1466. * fixed 'with object do' bug
  1467. Revision 1.17 1998/08/19 16:07:36 jonas
  1468. * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
  1469. Revision 1.16 1998/08/18 09:24:36 pierre
  1470. * small warning position bug fixed
  1471. * support_mmx switches splitting was missing
  1472. * rhide error and warning output corrected
  1473. Revision 1.15 1998/08/13 11:00:09 peter
  1474. * fixed procedure<>procedure construct
  1475. Revision 1.14 1998/08/11 14:05:33 peter
  1476. * fixed sizeof(array of char)
  1477. Revision 1.13 1998/08/10 14:49:45 peter
  1478. + localswitches, moduleswitches, globalswitches splitting
  1479. Revision 1.12 1998/07/30 13:30:31 florian
  1480. * final implemenation of exception support, maybe it needs
  1481. some fixes :)
  1482. Revision 1.11 1998/07/24 22:16:52 florian
  1483. * internal error 10 together with array access fixed. I hope
  1484. that's the final fix.
  1485. Revision 1.10 1998/07/18 22:54:23 florian
  1486. * some ansi/wide/longstring support fixed:
  1487. o parameter passing
  1488. o returning as result from functions
  1489. Revision 1.9 1998/07/07 17:40:37 peter
  1490. * packrecords 4 works
  1491. * word aligning of parameters
  1492. Revision 1.8 1998/07/06 15:51:15 michael
  1493. Added length checking for string reading
  1494. Revision 1.7 1998/07/06 14:19:51 michael
  1495. + Added calls for reading/writing ansistrings
  1496. Revision 1.6 1998/07/01 15:28:48 peter
  1497. + better writeln/readln handling, now 100% like tp7
  1498. Revision 1.5 1998/06/25 14:04:17 peter
  1499. + internal inc/dec
  1500. Revision 1.4 1998/06/25 08:48:06 florian
  1501. * first version of rtti support
  1502. Revision 1.3 1998/06/09 16:01:33 pierre
  1503. + added procedure directive parsing for procvars
  1504. (accepted are popstack cdecl and pascal)
  1505. + added C vars with the following syntax
  1506. var C calias 'true_c_name';(can be followed by external)
  1507. reason is that you must add the Cprefix
  1508. which is target dependent
  1509. Revision 1.2 1998/06/08 13:13:29 pierre
  1510. + temporary variables now in temp_gen.pas unit
  1511. because it is processor independent
  1512. * mppc68k.bat modified to undefine i386 and support_mmx
  1513. (which are defaults for i386)
  1514. Revision 1.1 1998/06/05 17:44:10 peter
  1515. * splitted cgi386
  1516. }