cg386cal.pas 71 KB

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