cg386cal.pas 88 KB

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