cg386cal.pas 79 KB

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