cg386cal.pas 75 KB

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