cg386cal.pas 83 KB

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