cg386cal.pas 73 KB

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