cg386cal.pas 74 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595
  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. truelabel:=otlabel;
  566. falselabel:=oflabel;
  567. { push from right to left }
  568. if not push_from_left_to_right and assigned(p^.right) then
  569. secondcallparan(p^.right,defcoll^.next,push_from_left_to_right,inlined,para_offset);
  570. end;
  571. {*****************************************************************************
  572. SecondCallN
  573. *****************************************************************************}
  574. procedure secondcalln(var p : ptree);
  575. var
  576. unusedregisters : tregisterset;
  577. pushed : tpushed;
  578. funcretref : treference;
  579. hregister : tregister;
  580. oldpushedparasize : longint;
  581. { true if ESI must be loaded again after the subroutine }
  582. loadesi : boolean;
  583. { true if a virtual method must be called directly }
  584. no_virtual_call : boolean;
  585. { true if we produce a con- or destrutor in a call }
  586. is_con_or_destructor : boolean;
  587. { true if a constructor is called again }
  588. extended_new : boolean;
  589. { adress returned from an I/O-error }
  590. iolabel : plabel;
  591. { lexlevel count }
  592. i : longint;
  593. { help reference pointer }
  594. r : preference;
  595. hp,
  596. pp,params : ptree;
  597. inlined : boolean;
  598. inlinecode : ptree;
  599. para_offset : longint;
  600. { instruction for alignement correction }
  601. { corr : pai386;}
  602. { we must pop this size also after !! }
  603. { must_pop : boolean; }
  604. pop_size : longint;
  605. label
  606. dont_call;
  607. begin
  608. extended_new:=false;
  609. iolabel:=nil;
  610. inlinecode:=nil;
  611. inlined:=false;
  612. loadesi:=true;
  613. no_virtual_call:=false;
  614. unusedregisters:=unused;
  615. if not assigned(p^.procdefinition) then
  616. exit;
  617. if (p^.procdefinition^.options and poinline)<>0 then
  618. begin
  619. inlined:=true;
  620. inlinecode:=p^.right;
  621. { set it to the same lexical level }
  622. p^.procdefinition^.parast^.symtablelevel:=
  623. aktprocsym^.definition^.parast^.symtablelevel;
  624. if assigned(p^.left) then
  625. inlinecode^.para_offset:=
  626. gettempofsizepersistant(inlinecode^.para_size);
  627. p^.procdefinition^.parast^.call_offset:=
  628. inlinecode^.para_offset;
  629. {$ifdef extdebug}
  630. Comment(V_debug,
  631. 'inlined parasymtable is at offset '
  632. +tostr(p^.procdefinition^.parast^.call_offset));
  633. exprasmlist^.concat(new(pai_asm_comment,init(
  634. strpnew('inlined parasymtable is at offset '
  635. +tostr(p^.procdefinition^.parast^.call_offset)))));
  636. {$endif extdebug}
  637. p^.right:=nil;
  638. { disable further inlining of the same proc
  639. in the args }
  640. p^.procdefinition^.options:=p^.procdefinition^.options and (not poinline);
  641. end;
  642. { only if no proc var }
  643. if not(assigned(p^.right)) then
  644. is_con_or_destructor:=((p^.procdefinition^.options and poconstructor)<>0)
  645. or ((p^.procdefinition^.options and podestructor)<>0);
  646. { proc variables destroy all registers }
  647. if (p^.right=nil) and
  648. { virtual methods too }
  649. ((p^.procdefinition^.options and povirtualmethod)=0) then
  650. begin
  651. if ((p^.procdefinition^.options and poiocheck)<>0) and
  652. (cs_check_io in aktlocalswitches) then
  653. begin
  654. getlabel(iolabel);
  655. emitl(A_LABEL,iolabel);
  656. end
  657. else
  658. iolabel:=nil;
  659. { save all used registers }
  660. pushusedregisters(pushed,p^.procdefinition^.usedregisters);
  661. { give used registers through }
  662. usedinproc:=usedinproc or p^.procdefinition^.usedregisters;
  663. end
  664. else
  665. begin
  666. pushusedregisters(pushed,$ff);
  667. usedinproc:=$ff;
  668. { no IO check for methods and procedure variables }
  669. iolabel:=nil;
  670. end;
  671. { generate the code for the parameter and push them }
  672. oldpushedparasize:=pushedparasize;
  673. pushedparasize:=0;
  674. pop_size:=0;
  675. if (not inlined) then
  676. begin
  677. { Old pushedsize aligned on 4 ? }
  678. i:=oldpushedparasize and 3;
  679. if i>0 then
  680. inc(pop_size,4-i);
  681. { This parasize aligned on 4 ? }
  682. i:=p^.procdefinition^.para_size and 3;
  683. if i>0 then
  684. inc(pop_size,4-i);
  685. { insert the opcode and update pushedparasize }
  686. if pop_size>0 then
  687. begin
  688. inc(pushedparasize,pop_size);
  689. exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,S_L,pop_size,R_ESP)));
  690. end;
  691. end;
  692. if (p^.resulttype<>pdef(voiddef)) and
  693. ret_in_param(p^.resulttype) then
  694. begin
  695. funcretref.symbol:=nil;
  696. {$ifdef test_dest_loc}
  697. if dest_loc_known and (dest_loc_tree=p) and
  698. (dest_loc.loc in [LOC_REFERENCE,LOC_MEM]) then
  699. begin
  700. funcretref:=dest_loc.reference;
  701. if assigned(dest_loc.reference.symbol) then
  702. funcretref.symbol:=stringdup(dest_loc.reference.symbol^);
  703. in_dest_loc:=true;
  704. end
  705. else
  706. {$endif test_dest_loc}
  707. if inlined then
  708. begin
  709. reset_reference(funcretref);
  710. funcretref.offset:=gettempofsizepersistant(p^.procdefinition^.retdef^.size);
  711. funcretref.base:=procinfo.framepointer;
  712. end
  713. else
  714. gettempofsizereference(p^.procdefinition^.retdef^.size,funcretref);
  715. end;
  716. if assigned(p^.left) then
  717. begin
  718. { be found elsewhere }
  719. if inlined then
  720. para_offset:=p^.procdefinition^.parast^.call_offset+
  721. p^.procdefinition^.parast^.datasize
  722. else
  723. para_offset:=0;
  724. if assigned(p^.right) then
  725. secondcallparan(p^.left,pprocvardef(p^.right^.resulttype)^.para1,
  726. (p^.procdefinition^.options and poleftright)<>0,inlined,para_offset)
  727. else
  728. secondcallparan(p^.left,p^.procdefinition^.para1,
  729. (p^.procdefinition^.options and poleftright)<>0,inlined,para_offset);
  730. end;
  731. params:=p^.left;
  732. p^.left:=nil;
  733. if inlined then
  734. inlinecode^.retoffset:=gettempofsizepersistant(4);
  735. if ret_in_param(p^.resulttype) then
  736. begin
  737. inc(pushedparasize,4);
  738. if inlined then
  739. begin
  740. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  741. newreference(funcretref),R_EDI)));
  742. r:=new_reference(procinfo.framepointer,inlinecode^.retoffset);
  743. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
  744. R_EDI,r)));
  745. end
  746. else
  747. emitpushreferenceaddr(exprasmlist,funcretref);
  748. end;
  749. { procedure variable ? }
  750. if (p^.right=nil) then
  751. begin
  752. { overloaded operator have no symtable }
  753. { push self }
  754. if assigned(p^.symtable) and
  755. (p^.symtable^.symtabletype=withsymtable) then
  756. begin
  757. { dirty trick to avoid the secondcall below }
  758. p^.methodpointer:=genzeronode(callparan);
  759. p^.methodpointer^.location.loc:=LOC_REGISTER;
  760. p^.methodpointer^.location.register:=R_ESI;
  761. p^.methodpointer^.resulttype:=p^.symtable^.defowner;
  762. { make a reference }
  763. new(r);
  764. reset_reference(r^);
  765. r^.offset:=p^.symtable^.datasize;
  766. r^.base:=procinfo.framepointer;
  767. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
  768. end;
  769. { push self }
  770. if assigned(p^.symtable) and
  771. ((p^.symtable^.symtabletype=objectsymtable) or
  772. (p^.symtable^.symtabletype=withsymtable)) then
  773. begin
  774. if assigned(p^.methodpointer) then
  775. begin
  776. {
  777. if p^.methodpointer^.resulttype=classrefdef then
  778. begin
  779. two possibilities:
  780. 1. constructor
  781. 2. class method
  782. end
  783. else }
  784. begin
  785. case p^.methodpointer^.treetype of
  786. typen:
  787. begin
  788. { direct call to inherited method }
  789. if (p^.procdefinition^.options and poabstractmethod)<>0 then
  790. begin
  791. CGMessage(cg_e_cant_call_abstract_method);
  792. goto dont_call;
  793. end;
  794. { generate no virtual call }
  795. no_virtual_call:=true;
  796. if (p^.symtableprocentry^.properties and sp_static)<>0 then
  797. begin
  798. { well lets put the VMT address directly into ESI }
  799. { it is kind of dirty but that is the simplest }
  800. { way to accept virtual static functions (PM) }
  801. loadesi:=true;
  802. exprasmlist^.concat(new(pai386,op_csymbol_reg(A_MOV,S_L,
  803. newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0),R_ESI)));
  804. maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
  805. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
  806. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  807. end
  808. else
  809. { this is a member call, so ESI isn't modfied }
  810. loadesi:=false;
  811. if not(is_con_or_destructor and
  812. pobjectdef(p^.methodpointer^.resulttype)^.isclass and
  813. assigned(aktprocsym) and
  814. ((aktprocsym^.definition^.options and
  815. (poconstructor or podestructor))<>0)) then
  816. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  817. { if an inherited con- or destructor should be }
  818. { called in a con- or destructor then a warning }
  819. { will be made }
  820. { con- and destructors need a pointer to the vmt }
  821. if is_con_or_destructor and
  822. not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) and
  823. assigned(aktprocsym) then
  824. begin
  825. if not ((aktprocsym^.definition^.options
  826. and (poconstructor or podestructor))<>0) then
  827. CGMessage(cg_w_member_cd_call_from_method);
  828. end;
  829. if is_con_or_destructor then
  830. push_int(0)
  831. end;
  832. hnewn:
  833. begin
  834. { extended syntax of new }
  835. { ESI must be zero }
  836. exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_ESI,R_ESI)));
  837. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  838. { insert the vmt }
  839. exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
  840. newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
  841. maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
  842. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
  843. extended_new:=true;
  844. end;
  845. hdisposen:
  846. begin
  847. secondpass(p^.methodpointer);
  848. { destructor with extended syntax called from dispose }
  849. { hdisposen always deliver LOC_REFERENCE }
  850. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  851. newreference(p^.methodpointer^.location.reference),R_ESI)));
  852. del_reference(p^.methodpointer^.location.reference);
  853. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  854. exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
  855. newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
  856. maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
  857. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
  858. end;
  859. else
  860. begin
  861. { call to an instance member }
  862. if (p^.symtable^.symtabletype<>withsymtable) then
  863. begin
  864. secondpass(p^.methodpointer);
  865. case p^.methodpointer^.location.loc of
  866. LOC_CREGISTER,
  867. LOC_REGISTER:
  868. begin
  869. ungetregister32(p^.methodpointer^.location.register);
  870. emit_reg_reg(A_MOV,S_L,p^.methodpointer^.location.register,R_ESI);
  871. end;
  872. else
  873. begin
  874. if (p^.methodpointer^.resulttype^.deftype=classrefdef) or
  875. ((p^.methodpointer^.resulttype^.deftype=objectdef) and
  876. pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  877. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  878. newreference(p^.methodpointer^.location.reference),R_ESI)))
  879. else
  880. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  881. newreference(p^.methodpointer^.location.reference),R_ESI)));
  882. del_reference(p^.methodpointer^.location.reference);
  883. end;
  884. end;
  885. end;
  886. { when calling a class method, we have
  887. to load ESI with the VMT !
  888. But that's wrong, if we call a class method via self
  889. }
  890. if ((p^.procdefinition^.options and poclassmethod)<>0)
  891. and not(p^.methodpointer^.resulttype^.deftype=classrefdef) then
  892. begin
  893. { class method needs current VMT }
  894. new(r);
  895. reset_reference(r^);
  896. r^.base:=R_ESI;
  897. r^.offset:= p^.procdefinition^._class^.vmt_offset;
  898. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
  899. end;
  900. { direct call to class constructor, don't allocate memory }
  901. if is_con_or_destructor and
  902. (p^.methodpointer^.resulttype^.deftype=objectdef) and
  903. (pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  904. exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,0)))
  905. else
  906. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  907. if is_con_or_destructor then
  908. begin
  909. { classes don't get a VMT pointer pushed }
  910. if (p^.methodpointer^.resulttype^.deftype=objectdef) and
  911. not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  912. begin
  913. if ((p^.procdefinition^.options and poconstructor)<>0) then
  914. begin
  915. { it's no bad idea, to insert the VMT }
  916. exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
  917. newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,
  918. 0))));
  919. maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
  920. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
  921. end
  922. { destructors haven't to dispose the instance, if this is }
  923. { a direct call }
  924. else
  925. push_int(0);
  926. end;
  927. end;
  928. end;
  929. end;
  930. end;
  931. end
  932. else
  933. begin
  934. if ((p^.procdefinition^.options and poclassmethod)<>0) and
  935. not(
  936. assigned(aktprocsym) and
  937. ((aktprocsym^.definition^.options and poclassmethod)<>0)
  938. ) then
  939. begin
  940. { class method needs current VMT }
  941. new(r);
  942. reset_reference(r^);
  943. r^.base:=R_ESI;
  944. r^.offset:= p^.procdefinition^._class^.vmt_offset;
  945. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
  946. end
  947. else
  948. begin
  949. { member call, ESI isn't modified }
  950. loadesi:=false;
  951. end;
  952. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  953. { but a con- or destructor here would probably almost }
  954. { always be placed wrong }
  955. if is_con_or_destructor then
  956. begin
  957. CGMessage(cg_w_member_cd_call_from_method);
  958. push_int(0);
  959. end;
  960. end;
  961. end;
  962. { push base pointer ?}
  963. if (lexlevel>1) and assigned(pprocdef(p^.procdefinition)^.parast) and
  964. ((p^.procdefinition^.parast^.symtablelevel)>2) then
  965. begin
  966. { if we call a nested function in a method, we must }
  967. { push also SELF! }
  968. { THAT'S NOT TRUE, we have to load ESI via frame pointer }
  969. { access }
  970. {
  971. begin
  972. loadesi:=false;
  973. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  974. end;
  975. }
  976. if lexlevel=(p^.procdefinition^.parast^.symtablelevel) then
  977. begin
  978. new(r);
  979. reset_reference(r^);
  980. r^.offset:=procinfo.framepointer_offset;
  981. r^.base:=procinfo.framepointer;
  982. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,r)))
  983. end
  984. { this is only true if the difference is one !!
  985. but it cannot be more !! }
  986. else if (lexlevel=p^.procdefinition^.parast^.symtablelevel-1) then
  987. begin
  988. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,procinfo.framepointer)))
  989. end
  990. else if (lexlevel>p^.procdefinition^.parast^.symtablelevel) then
  991. begin
  992. hregister:=getregister32;
  993. new(r);
  994. reset_reference(r^);
  995. r^.offset:=procinfo.framepointer_offset;
  996. r^.base:=procinfo.framepointer;
  997. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,hregister)));
  998. for i:=(p^.procdefinition^.parast^.symtablelevel) to lexlevel-1 do
  999. begin
  1000. new(r);
  1001. reset_reference(r^);
  1002. {we should get the correct frame_pointer_offset at each level
  1003. how can we do this !!! }
  1004. r^.offset:=procinfo.framepointer_offset;
  1005. r^.base:=hregister;
  1006. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,hregister)));
  1007. end;
  1008. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,hregister)));
  1009. ungetregister32(hregister);
  1010. end
  1011. else
  1012. internalerror(25000);
  1013. end;
  1014. if ((p^.procdefinition^.options and povirtualmethod)<>0) and
  1015. not(no_virtual_call) then
  1016. begin
  1017. { static functions contain the vmt_address in ESI }
  1018. { also class methods }
  1019. if assigned(aktprocsym) then
  1020. begin
  1021. if ((aktprocsym^.properties and sp_static)<>0) or
  1022. ((aktprocsym^.definition^.options and poclassmethod)<>0) or
  1023. ((p^.procdefinition^.options and postaticmethod)<>0) or
  1024. ((p^.procdefinition^.options and poconstructor)<>0) or
  1025. { ESI is loaded earlier }
  1026. ((p^.procdefinition^.options and poclassmethod)<>0)then
  1027. begin
  1028. new(r);
  1029. reset_reference(r^);
  1030. r^.base:=R_ESI;
  1031. end
  1032. else
  1033. begin
  1034. new(r);
  1035. reset_reference(r^);
  1036. r^.base:=R_ESI;
  1037. { this is one point where we need vmt_offset (PM) }
  1038. r^.offset:= p^.procdefinition^._class^.vmt_offset;
  1039. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
  1040. new(r);
  1041. reset_reference(r^);
  1042. r^.base:=R_EDI;
  1043. end;
  1044. end
  1045. else
  1046. { aktprocsym should be assigned, also in main program }
  1047. internalerror(12345);
  1048. {
  1049. begin
  1050. new(r);
  1051. reset_reference(r^);
  1052. r^.base:=R_ESI;
  1053. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
  1054. new(r);
  1055. reset_reference(r^);
  1056. r^.base:=R_EDI;
  1057. end;
  1058. }
  1059. if p^.procdefinition^.extnumber=-1 then
  1060. internalerror($Da);
  1061. r^.offset:=p^.procdefinition^.extnumber*4+12;
  1062. if (cs_check_range in aktlocalswitches) then
  1063. begin
  1064. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,r^.base)));
  1065. emitcall('FPC_CHECK_OBJECT',true);
  1066. end;
  1067. exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,r)));
  1068. end
  1069. else if not inlined then
  1070. emitcall(p^.procdefinition^.mangledname,
  1071. (p^.symtableproc^.symtabletype=unitsymtable) or
  1072. ((p^.symtableproc^.symtabletype=objectsymtable) and
  1073. (pobjectdef(p^.symtableproc^.defowner)^.owner^.symtabletype=unitsymtable)))
  1074. else { inlined proc }
  1075. { inlined code is in inlinecode }
  1076. begin
  1077. secondpass(inlinecode);
  1078. { set poinline again }
  1079. p^.procdefinition^.options:=p^.procdefinition^.options or poinline;
  1080. { free the args }
  1081. ungetpersistanttemp(p^.procdefinition^.parast^.call_offset,
  1082. p^.procdefinition^.parast^.datasize);
  1083. end;
  1084. end
  1085. else
  1086. { now procedure variable case }
  1087. begin
  1088. secondpass(p^.right);
  1089. { method pointer ? }
  1090. if (p^.procdefinition^.options and pomethodpointer)<>0 then
  1091. begin
  1092. { method pointer can't be in a register }
  1093. inc(p^.right^.location.reference.offset,4);
  1094. { push self pointer }
  1095. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,newreference(p^.right^.location.reference))));
  1096. del_reference(p^.right^.location.reference);
  1097. dec(p^.right^.location.reference.offset,4);
  1098. end;
  1099. case p^.right^.location.loc of
  1100. LOC_REGISTER,LOC_CREGISTER:
  1101. begin
  1102. exprasmlist^.concat(new(pai386,op_reg(A_CALL,S_NO,p^.right^.location.register)));
  1103. ungetregister32(p^.right^.location.register);
  1104. end
  1105. else
  1106. exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,newreference(p^.right^.location.reference))));
  1107. del_reference(p^.right^.location.reference);
  1108. end;
  1109. end;
  1110. { this was only for normal functions
  1111. displaced here so we also get
  1112. it to work for procvars PM }
  1113. if (not inlined) and ((p^.procdefinition^.options and poclearstack)<>0) then
  1114. begin
  1115. { consider the alignment with the rest (PM) }
  1116. inc(pushedparasize,pop_size);
  1117. pop_size:=0;
  1118. { better than an add on all processors }
  1119. if pushedparasize=4 then
  1120. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)))
  1121. { the pentium has two pipes and pop reg is pairable }
  1122. { but the registers must be different! }
  1123. else if (pushedparasize=8) and
  1124. not(cs_littlesize in aktglobalswitches) and
  1125. (aktoptprocessor=ClassP5) and
  1126. (procinfo._class=nil) then
  1127. begin
  1128. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
  1129. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_ESI)));
  1130. end
  1131. else exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,pushedparasize,R_ESP)));
  1132. end;
  1133. dont_call:
  1134. pushedparasize:=oldpushedparasize;
  1135. unused:=unusedregisters;
  1136. { handle function results }
  1137. { structured results are easy to handle.... }
  1138. { needed also when result_no_used !! }
  1139. if (p^.resulttype<>pdef(voiddef)) and ret_in_param(p^.resulttype) then
  1140. begin
  1141. p^.location.loc:=LOC_MEM;
  1142. stringdispose(p^.location.reference.symbol);
  1143. p^.location.reference:=funcretref;
  1144. end;
  1145. if (p^.resulttype<>pdef(voiddef)) and p^.return_value_used then
  1146. begin
  1147. { a contructor could be a function with boolean result }
  1148. if (p^.right=nil) and
  1149. ((p^.procdefinition^.options and poconstructor)<>0) and
  1150. { quick'n'dirty check if it is a class or an object }
  1151. (p^.resulttype^.deftype=orddef) then
  1152. begin
  1153. p^.location.loc:=LOC_FLAGS;
  1154. p^.location.resflags:=F_NE;
  1155. if extended_new then
  1156. begin
  1157. {$ifdef test_dest_loc}
  1158. if dest_loc_known and (dest_loc_tree=p) then
  1159. mov_reg_to_dest(p,S_L,R_EAX)
  1160. else
  1161. {$endif test_dest_loc}
  1162. begin
  1163. hregister:=getregister32;
  1164. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1165. p^.location.register:=hregister;
  1166. end;
  1167. end;
  1168. end
  1169. { structed results are easy to handle.... }
  1170. else if ret_in_param(p^.resulttype) then
  1171. begin
  1172. {p^.location.loc:=LOC_MEM;
  1173. stringdispose(p^.location.reference.symbol);
  1174. p^.location.reference:=funcretref;
  1175. already done above (PM) }
  1176. end
  1177. else
  1178. begin
  1179. if (p^.resulttype^.deftype=orddef) then
  1180. begin
  1181. p^.location.loc:=LOC_REGISTER;
  1182. case porddef(p^.resulttype)^.typ of
  1183. s32bit,u32bit,bool32bit :
  1184. begin
  1185. {$ifdef test_dest_loc}
  1186. if dest_loc_known and (dest_loc_tree=p) then
  1187. mov_reg_to_dest(p,S_L,R_EAX)
  1188. else
  1189. {$endif test_dest_loc}
  1190. begin
  1191. hregister:=getregister32;
  1192. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1193. p^.location.register:=hregister;
  1194. end;
  1195. end;
  1196. uchar,u8bit,bool8bit,s8bit :
  1197. begin
  1198. {$ifdef test_dest_loc}
  1199. if dest_loc_known and (dest_loc_tree=p) then
  1200. mov_reg_to_dest(p,S_B,R_AL)
  1201. else
  1202. {$endif test_dest_loc}
  1203. begin
  1204. hregister:=getregister32;
  1205. emit_reg_reg(A_MOV,S_B,R_AL,reg32toreg8(hregister));
  1206. p^.location.register:=reg32toreg8(hregister);
  1207. end;
  1208. end;
  1209. s16bit,u16bit,bool16bit :
  1210. begin
  1211. {$ifdef test_dest_loc}
  1212. if dest_loc_known and (dest_loc_tree=p) then
  1213. mov_reg_to_dest(p,S_W,R_AX)
  1214. else
  1215. {$endif test_dest_loc}
  1216. begin
  1217. hregister:=getregister32;
  1218. emit_reg_reg(A_MOV,S_W,R_AX,reg32toreg16(hregister));
  1219. p^.location.register:=reg32toreg16(hregister);
  1220. end;
  1221. end;
  1222. else internalerror(7);
  1223. end
  1224. end
  1225. else if (p^.resulttype^.deftype=floatdef) then
  1226. case pfloatdef(p^.resulttype)^.typ of
  1227. f32bit : begin
  1228. p^.location.loc:=LOC_REGISTER;
  1229. {$ifdef test_dest_loc}
  1230. if dest_loc_known and (dest_loc_tree=p) then
  1231. mov_reg_to_dest(p,S_L,R_EAX)
  1232. else
  1233. {$endif test_dest_loc}
  1234. begin
  1235. hregister:=getregister32;
  1236. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1237. p^.location.register:=hregister;
  1238. end;
  1239. end;
  1240. else
  1241. p^.location.loc:=LOC_FPU;
  1242. end
  1243. else
  1244. begin
  1245. p^.location.loc:=LOC_REGISTER;
  1246. {$ifdef test_dest_loc}
  1247. if dest_loc_known and (dest_loc_tree=p) then
  1248. mov_reg_to_dest(p,S_L,R_EAX)
  1249. else
  1250. {$endif test_dest_loc}
  1251. begin
  1252. hregister:=getregister32;
  1253. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1254. p^.location.register:=hregister;
  1255. end;
  1256. end;
  1257. end;
  1258. end;
  1259. { perhaps i/o check ? }
  1260. if iolabel<>nil then
  1261. begin
  1262. exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,newcsymbol(lab2str(iolabel),0))));
  1263. emitcall('FPC_IOCHECK',true);
  1264. end;
  1265. if pop_size>0 then
  1266. exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,pop_size,R_ESP)));
  1267. { restore registers }
  1268. popusedregisters(pushed);
  1269. { at last, restore instance pointer (SELF) }
  1270. if loadesi then
  1271. maybe_loadesi;
  1272. pp:=params;
  1273. while assigned(pp) do
  1274. begin
  1275. if assigned(pp^.left) then
  1276. begin
  1277. if pp^.left^.location.loc in [LOC_REFERENCE,LOC_MEM] then
  1278. ungetiftemp(pp^.left^.location.reference);
  1279. { process also all nodes of an array of const }
  1280. if pp^.left^.treetype=arrayconstructn then
  1281. begin
  1282. if assigned(pp^.left^.left) then
  1283. begin
  1284. hp:=pp^.left;
  1285. while assigned(hp) do
  1286. begin
  1287. if hp^.left^.location.loc in [LOC_REFERENCE,LOC_MEM] then
  1288. ungetiftemp(hp^.left^.location.reference);
  1289. hp:=hp^.right;
  1290. end;
  1291. end;
  1292. end;
  1293. end;
  1294. pp:=pp^.right;
  1295. end;
  1296. if inlined then
  1297. ungetpersistanttemp(inlinecode^.retoffset,4);
  1298. disposetree(params);
  1299. { from now on the result can be freed normally }
  1300. if inlined and ret_in_param(p^.resulttype) then
  1301. persistanttemptonormal(funcretref.offset);
  1302. { if return value is not used }
  1303. if (not p^.return_value_used) and (p^.resulttype<>pdef(voiddef)) then
  1304. begin
  1305. if p^.location.loc in [LOC_MEM,LOC_REFERENCE] then
  1306. { release unused temp }
  1307. ungetiftemp(p^.location.reference)
  1308. else if p^.location.loc=LOC_FPU then
  1309. { release FPU stack }
  1310. exprasmlist^.concat(new(pai386,op_none(A_FDECSTP,S_NO)));
  1311. end;
  1312. end;
  1313. {*****************************************************************************
  1314. SecondProcInlineN
  1315. *****************************************************************************}
  1316. { implementation not complete yet }
  1317. var
  1318. addr_correction : longint;
  1319. procedure correct_address(p : psym);{$ifndef FPC}far;{$endif}
  1320. begin
  1321. if p^.typ=varsym then
  1322. begin
  1323. inc(pvarsym(p)^.address,addr_correction);
  1324. {$ifdef extdebug}
  1325. Comment(V_debug,pvarsym(p)^.name+' is at offset -'
  1326. +tostr(pvarsym(p)^.address));
  1327. exprasmlist^.concat(new(pai_asm_comment,init(
  1328. strpnew(pvarsym(p)^.name+' is at offset -'
  1329. +tostr(pvarsym(p)^.address)))));
  1330. {$endif extdebug}
  1331. end;
  1332. end;
  1333. procedure secondprocinline(var p : ptree);
  1334. var st : psymtable;
  1335. oldprocsym : pprocsym;
  1336. para_size : longint;
  1337. oldprocinfo : tprocinfo;
  1338. { just dummies for genentrycode }
  1339. nostackframe,make_global : boolean;
  1340. proc_names : tstringcontainer;
  1341. inlineentrycode,inlineexitcode : paasmoutput;
  1342. oldexitlabel,oldexit2label,oldquickexitlabel:Plabel;
  1343. begin
  1344. oldexitlabel:=aktexitlabel;
  1345. oldexit2label:=aktexit2label;
  1346. oldquickexitlabel:=quickexitlabel;
  1347. getlabel(aktexitlabel);
  1348. getlabel(aktexit2label);
  1349. oldprocsym:=aktprocsym;
  1350. oldprocinfo:=procinfo;
  1351. { set the return value }
  1352. procinfo.retdef:=p^.inlineprocdef^.retdef;
  1353. procinfo.retoffset:=p^.retoffset;
  1354. { arg space has been filled by the parent secondcall }
  1355. st:=p^.inlineprocdef^.localst;
  1356. { set it to the same lexical level }
  1357. st^.symtablelevel:=
  1358. oldprocsym^.definition^.localst^.symtablelevel;
  1359. if st^.datasize>0 then
  1360. st^.call_offset:=gettempofsizepersistant(st^.datasize);
  1361. {$ifdef extdebug}
  1362. Comment(V_debug,'local symtable is at offset '
  1363. +tostr(st^.call_offset));
  1364. exprasmlist^.concat(new(pai_asm_comment,init(
  1365. strpnew('local symtable is at offset '
  1366. +tostr(st^.call_offset)))));
  1367. {$endif extdebug}
  1368. addr_correction:=-st^.call_offset-st^.datasize;
  1369. st^.foreach(correct_address);
  1370. {$ifdef extdebug}
  1371. exprasmlist^.concat(new(pai_asm_comment,init('Start of inlined proc')));
  1372. {$endif extdebug}
  1373. { takes care of local data initialization }
  1374. inlineentrycode:=new(paasmoutput,init);
  1375. inlineexitcode:=new(paasmoutput,init);
  1376. proc_names.init;
  1377. para_size:=p^.para_size;
  1378. make_global:=false; { to avoid warning }
  1379. genentrycode(inlineentrycode,proc_names,make_global,0,para_size,nostackframe,true);
  1380. exprasmlist^.concatlist(inlineentrycode);
  1381. secondpass(p^.left);
  1382. genexitcode(inlineexitcode,0,false,true);
  1383. exprasmlist^.concatlist(inlineexitcode);
  1384. {$ifdef extdebug}
  1385. exprasmlist^.concat(new(pai_asm_comment,init('End of inlined proc')));
  1386. {$endif extdebug}
  1387. {we can free the local data now }
  1388. if st^.datasize>0 then
  1389. ungetpersistanttemp(st^.call_offset,st^.datasize);
  1390. { set the real address again }
  1391. addr_correction:=-addr_correction;
  1392. st^.foreach(correct_address);
  1393. aktprocsym:=oldprocsym;
  1394. aktexitlabel:=oldexitlabel;
  1395. aktexit2label:=oldexit2label;
  1396. quickexitlabel:=oldquickexitlabel;
  1397. procinfo:=oldprocinfo;
  1398. end;
  1399. end.
  1400. {
  1401. $Log$
  1402. Revision 1.32 1998-10-01 09:22:52 peter
  1403. * fixed value openarray
  1404. * ungettemp of arrayconstruct
  1405. Revision 1.31 1998/09/28 16:57:15 pierre
  1406. * changed all length(p^.value_str^) into str_length(p)
  1407. to get it work with and without ansistrings
  1408. * changed sourcefiles field of tmodule to a pointer
  1409. Revision 1.30 1998/09/26 15:03:02 florian
  1410. * small problems with DOM and excpetions fixed (code generation
  1411. of raise was wrong and self was sometimes destroyed :()
  1412. Revision 1.29 1998/09/25 00:04:00 florian
  1413. * problems when calling class methods fixed
  1414. Revision 1.28 1998/09/24 14:27:37 peter
  1415. * some better support for openarray
  1416. Revision 1.27 1998/09/24 09:02:13 peter
  1417. * rewritten isconvertable to use case
  1418. * array of .. and single variable are compatible
  1419. Revision 1.26 1998/09/21 08:45:06 pierre
  1420. + added vmt_offset in tobjectdef.write for fututre use
  1421. (first steps to have objects without vmt if no virtual !!)
  1422. + added fpu_used field for tabstractprocdef :
  1423. sets this level to 2 if the functions return with value in FPU
  1424. (is then set to correct value at parsing of implementation)
  1425. THIS MIGHT refuse some code with FPU expression too complex
  1426. that were accepted before and even in some cases
  1427. that don't overflow in fact
  1428. ( like if f : float; is a forward that finally in implementation
  1429. only uses one fpu register !!)
  1430. Nevertheless I think that it will improve security on
  1431. FPU operations !!
  1432. * most other changes only for UseBrowser code
  1433. (added symtable references for record and objects)
  1434. local switch for refs to args and local of each function
  1435. (static symtable still missing)
  1436. UseBrowser still not stable and probably broken by
  1437. the definition hash array !!
  1438. Revision 1.25 1998/09/20 12:26:35 peter
  1439. * merged fixes
  1440. Revision 1.24 1998/09/17 09:42:10 peter
  1441. + pass_2 for cg386
  1442. * Message() -> CGMessage() for pass_1/pass_2
  1443. Revision 1.23 1998/09/14 10:43:45 peter
  1444. * all internal RTL functions start with FPC_
  1445. Revision 1.22.2.1 1998/09/20 12:20:06 peter
  1446. * Fixed stack not on 4 byte boundary when doing a call
  1447. Revision 1.22 1998/09/04 08:41:37 peter
  1448. * updated some error CGMessages
  1449. Revision 1.21 1998/09/01 12:47:57 peter
  1450. * use pdef^.size instead of orddef^.typ
  1451. Revision 1.20 1998/08/31 12:22:15 peter
  1452. * secondinline moved to cg386inl
  1453. Revision 1.19 1998/08/31 08:52:03 peter
  1454. * fixed error 10 with succ() and pref()
  1455. Revision 1.18 1998/08/20 21:36:38 peter
  1456. * fixed 'with object do' bug
  1457. Revision 1.17 1998/08/19 16:07:36 jonas
  1458. * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
  1459. Revision 1.16 1998/08/18 09:24:36 pierre
  1460. * small warning position bug fixed
  1461. * support_mmx switches splitting was missing
  1462. * rhide error and warning output corrected
  1463. Revision 1.15 1998/08/13 11:00:09 peter
  1464. * fixed procedure<>procedure construct
  1465. Revision 1.14 1998/08/11 14:05:33 peter
  1466. * fixed sizeof(array of char)
  1467. Revision 1.13 1998/08/10 14:49:45 peter
  1468. + localswitches, moduleswitches, globalswitches splitting
  1469. Revision 1.12 1998/07/30 13:30:31 florian
  1470. * final implemenation of exception support, maybe it needs
  1471. some fixes :)
  1472. Revision 1.11 1998/07/24 22:16:52 florian
  1473. * internal error 10 together with array access fixed. I hope
  1474. that's the final fix.
  1475. Revision 1.10 1998/07/18 22:54:23 florian
  1476. * some ansi/wide/longstring support fixed:
  1477. o parameter passing
  1478. o returning as result from functions
  1479. Revision 1.9 1998/07/07 17:40:37 peter
  1480. * packrecords 4 works
  1481. * word aligning of parameters
  1482. Revision 1.8 1998/07/06 15:51:15 michael
  1483. Added length checking for string reading
  1484. Revision 1.7 1998/07/06 14:19:51 michael
  1485. + Added calls for reading/writing ansistrings
  1486. Revision 1.6 1998/07/01 15:28:48 peter
  1487. + better writeln/readln handling, now 100% like tp7
  1488. Revision 1.5 1998/06/25 14:04:17 peter
  1489. + internal inc/dec
  1490. Revision 1.4 1998/06/25 08:48:06 florian
  1491. * first version of rtti support
  1492. Revision 1.3 1998/06/09 16:01:33 pierre
  1493. + added procedure directive parsing for procvars
  1494. (accepted are popstack cdecl and pascal)
  1495. + added C vars with the following syntax
  1496. var C calias 'true_c_name';(can be followed by external)
  1497. reason is that you must add the Cprefix
  1498. which is target dependent
  1499. Revision 1.2 1998/06/08 13:13:29 pierre
  1500. + temporary variables now in temp_gen.pas unit
  1501. because it is processor independent
  1502. * mppc68k.bat modified to undefine i386 and support_mmx
  1503. (which are defaults for i386)
  1504. Revision 1.1 1998/06/05 17:44:10 peter
  1505. * splitted cgi386
  1506. }