cg386cal.pas 79 KB

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