cg386cal.pas 86 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865
  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 : 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. label
  747. dont_call;
  748. begin
  749. extended_new:=false;
  750. iolabel:=nil;
  751. inlinecode:=nil;
  752. inlined:=false;
  753. loadesi:=true;
  754. no_virtual_call:=false;
  755. unusedregisters:=unused;
  756. if not assigned(p^.procdefinition) then
  757. exit;
  758. if (p^.procdefinition^.options and poinline)<>0 then
  759. begin
  760. inlined:=true;
  761. inlinecode:=p^.right;
  762. { set it to the same lexical level }
  763. p^.procdefinition^.parast^.symtablelevel:=
  764. aktprocsym^.definition^.parast^.symtablelevel;
  765. if assigned(p^.left) then
  766. inlinecode^.para_offset:=
  767. gettempofsizepersistant(inlinecode^.para_size);
  768. p^.procdefinition^.parast^.call_offset:=
  769. inlinecode^.para_offset;
  770. {$ifdef extdebug}
  771. Comment(V_debug,
  772. 'inlined parasymtable is at offset '
  773. +tostr(p^.procdefinition^.parast^.call_offset));
  774. exprasmlist^.concat(new(pai_asm_comment,init(
  775. strpnew('inlined parasymtable is at offset '
  776. +tostr(p^.procdefinition^.parast^.call_offset)))));
  777. {$endif extdebug}
  778. p^.right:=nil;
  779. { disable further inlining of the same proc
  780. in the args }
  781. p^.procdefinition^.options:=p^.procdefinition^.options and (not poinline);
  782. end;
  783. { only if no proc var }
  784. if not(assigned(p^.right)) then
  785. is_con_or_destructor:=((p^.procdefinition^.options and poconstructor)<>0)
  786. or ((p^.procdefinition^.options and podestructor)<>0);
  787. { proc variables destroy all registers }
  788. if (p^.right=nil) and
  789. { virtual methods too }
  790. ((p^.procdefinition^.options and povirtualmethod)=0) then
  791. begin
  792. if ((p^.procdefinition^.options and poiocheck)<>0) and
  793. ((aktprocsym^.definition^.options and poiocheck)=0) and
  794. (cs_check_io in aktlocalswitches) then
  795. begin
  796. getlabel(iolabel);
  797. emitl(A_LABEL,iolabel);
  798. end
  799. else
  800. iolabel:=nil;
  801. { save all used registers }
  802. pushusedregisters(pushed,p^.procdefinition^.usedregisters);
  803. { give used registers through }
  804. usedinproc:=usedinproc or p^.procdefinition^.usedregisters;
  805. end
  806. else
  807. begin
  808. pushusedregisters(pushed,$ff);
  809. usedinproc:=$ff;
  810. { no IO check for methods and procedure variables }
  811. iolabel:=nil;
  812. end;
  813. { generate the code for the parameter and push them }
  814. oldpushedparasize:=pushedparasize;
  815. pushedparasize:=0;
  816. pop_size:=0;
  817. if (not inlined) then
  818. begin
  819. { Old pushedsize aligned on 4 ? }
  820. i:=oldpushedparasize and 3;
  821. if i>0 then
  822. inc(pop_size,4-i);
  823. { This parasize aligned on 4 ? }
  824. i:=p^.procdefinition^.para_size and 3;
  825. if i>0 then
  826. inc(pop_size,4-i);
  827. { insert the opcode and update pushedparasize }
  828. if pop_size>0 then
  829. begin
  830. inc(pushedparasize,pop_size);
  831. exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,S_L,pop_size,R_ESP)));
  832. {$ifdef GDB}
  833. if (cs_debuginfo in aktmoduleswitches) and
  834. (exprasmlist^.first=exprasmlist^.last) then
  835. exprasmlist^.concat(new(pai_force_line,init));
  836. {$endif GDB}
  837. end;
  838. end;
  839. if (p^.resulttype<>pdef(voiddef)) and
  840. ret_in_param(p^.resulttype) then
  841. begin
  842. funcretref.symbol:=nil;
  843. {$ifdef test_dest_loc}
  844. if dest_loc_known and (dest_loc_tree=p) and
  845. (dest_loc.loc in [LOC_REFERENCE,LOC_MEM]) then
  846. begin
  847. funcretref:=dest_loc.reference;
  848. if assigned(dest_loc.reference.symbol) then
  849. funcretref.symbol:=stringdup(dest_loc.reference.symbol^);
  850. in_dest_loc:=true;
  851. end
  852. else
  853. {$endif test_dest_loc}
  854. if inlined then
  855. begin
  856. reset_reference(funcretref);
  857. funcretref.offset:=gettempofsizepersistant(p^.procdefinition^.retdef^.size);
  858. funcretref.base:=procinfo.framepointer;
  859. end
  860. else
  861. gettempofsizereference(p^.procdefinition^.retdef^.size,funcretref);
  862. end;
  863. if assigned(p^.left) then
  864. begin
  865. { be found elsewhere }
  866. if inlined then
  867. para_offset:=p^.procdefinition^.parast^.call_offset+
  868. p^.procdefinition^.parast^.datasize
  869. else
  870. para_offset:=0;
  871. if assigned(p^.right) then
  872. secondcallparan(p^.left,pprocvardef(p^.right^.resulttype)^.para1,
  873. (p^.procdefinition^.options and poleftright)<>0,inlined,para_offset)
  874. else
  875. secondcallparan(p^.left,p^.procdefinition^.para1,
  876. (p^.procdefinition^.options and poleftright)<>0,inlined,para_offset);
  877. end;
  878. params:=p^.left;
  879. p^.left:=nil;
  880. if inlined then
  881. inlinecode^.retoffset:=gettempofsizepersistant(4);
  882. if ret_in_param(p^.resulttype) then
  883. begin
  884. inc(pushedparasize,4);
  885. if inlined then
  886. begin
  887. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  888. newreference(funcretref),R_EDI)));
  889. r:=new_reference(procinfo.framepointer,inlinecode^.retoffset);
  890. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
  891. R_EDI,r)));
  892. end
  893. else
  894. emitpushreferenceaddr(exprasmlist,funcretref);
  895. end;
  896. { procedure variable ? }
  897. if (p^.right=nil) then
  898. begin
  899. { overloaded operator have no symtable }
  900. { push self }
  901. if assigned(p^.symtable) and
  902. (p^.symtable^.symtabletype=withsymtable) then
  903. begin
  904. { dirty trick to avoid the secondcall below }
  905. p^.methodpointer:=genzeronode(callparan);
  906. p^.methodpointer^.location.loc:=LOC_REGISTER;
  907. p^.methodpointer^.location.register:=R_ESI;
  908. p^.methodpointer^.resulttype:=p^.symtable^.defowner;
  909. { change dispose type !! }
  910. p^.disposetyp:=dt_mbleft_and_method;
  911. { make a reference }
  912. new(r);
  913. reset_reference(r^);
  914. r^.offset:=p^.symtable^.datasize;
  915. r^.base:=procinfo.framepointer;
  916. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
  917. end;
  918. { push self }
  919. if assigned(p^.symtable) and
  920. ((p^.symtable^.symtabletype=objectsymtable) or
  921. (p^.symtable^.symtabletype=withsymtable)) then
  922. begin
  923. if assigned(p^.methodpointer) then
  924. begin
  925. {
  926. if p^.methodpointer^.resulttype=classrefdef then
  927. begin
  928. two possibilities:
  929. 1. constructor
  930. 2. class method
  931. end
  932. else }
  933. begin
  934. case p^.methodpointer^.treetype of
  935. typen:
  936. begin
  937. { direct call to inherited method }
  938. if (p^.procdefinition^.options and poabstractmethod)<>0 then
  939. begin
  940. CGMessage(cg_e_cant_call_abstract_method);
  941. goto dont_call;
  942. end;
  943. { generate no virtual call }
  944. no_virtual_call:=true;
  945. if (p^.symtableprocentry^.properties and sp_static)<>0 then
  946. begin
  947. { well lets put the VMT address directly into ESI }
  948. { it is kind of dirty but that is the simplest }
  949. { way to accept virtual static functions (PM) }
  950. loadesi:=true;
  951. exprasmlist^.concat(new(pai386,op_csymbol_reg(A_MOV,S_L,
  952. newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0),R_ESI)));
  953. maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
  954. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
  955. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  956. end
  957. else
  958. { this is a member call, so ESI isn't modfied }
  959. loadesi:=false;
  960. if not(is_con_or_destructor and
  961. pobjectdef(p^.methodpointer^.resulttype)^.isclass and
  962. assigned(aktprocsym) and
  963. ((aktprocsym^.definition^.options and
  964. (poconstructor or podestructor))<>0)) then
  965. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  966. { if an inherited con- or destructor should be }
  967. { called in a con- or destructor then a warning }
  968. { will be made }
  969. { con- and destructors need a pointer to the vmt }
  970. if is_con_or_destructor and
  971. not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) and
  972. assigned(aktprocsym) then
  973. begin
  974. if not ((aktprocsym^.definition^.options
  975. and (poconstructor or podestructor))<>0) then
  976. CGMessage(cg_w_member_cd_call_from_method);
  977. end;
  978. if is_con_or_destructor then
  979. push_int(0)
  980. end;
  981. hnewn:
  982. begin
  983. { extended syntax of new }
  984. { ESI must be zero }
  985. exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_ESI,R_ESI)));
  986. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  987. { insert the vmt }
  988. exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
  989. newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
  990. maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
  991. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
  992. extended_new:=true;
  993. end;
  994. hdisposen:
  995. begin
  996. secondpass(p^.methodpointer);
  997. { destructor with extended syntax called from dispose }
  998. { hdisposen always deliver LOC_REFERENCE }
  999. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  1000. newreference(p^.methodpointer^.location.reference),R_ESI)));
  1001. del_reference(p^.methodpointer^.location.reference);
  1002. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  1003. exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
  1004. newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
  1005. maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
  1006. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
  1007. end;
  1008. else
  1009. begin
  1010. { call to an instance member }
  1011. if (p^.symtable^.symtabletype<>withsymtable) then
  1012. begin
  1013. secondpass(p^.methodpointer);
  1014. case p^.methodpointer^.location.loc of
  1015. LOC_CREGISTER,
  1016. LOC_REGISTER:
  1017. begin
  1018. ungetregister32(p^.methodpointer^.location.register);
  1019. emit_reg_reg(A_MOV,S_L,p^.methodpointer^.location.register,R_ESI);
  1020. end;
  1021. else
  1022. begin
  1023. if (p^.methodpointer^.resulttype^.deftype=classrefdef) or
  1024. ((p^.methodpointer^.resulttype^.deftype=objectdef) and
  1025. pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  1026. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  1027. newreference(p^.methodpointer^.location.reference),R_ESI)))
  1028. else
  1029. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  1030. newreference(p^.methodpointer^.location.reference),R_ESI)));
  1031. del_reference(p^.methodpointer^.location.reference);
  1032. end;
  1033. end;
  1034. end;
  1035. { when calling a class method, we have
  1036. to load ESI with the VMT !
  1037. But that's wrong, if we call a class method via self
  1038. }
  1039. if ((p^.procdefinition^.options and poclassmethod)<>0)
  1040. and not(p^.methodpointer^.resulttype^.deftype=classrefdef) then
  1041. begin
  1042. { class method needs current VMT }
  1043. new(r);
  1044. reset_reference(r^);
  1045. r^.base:=R_ESI;
  1046. r^.offset:= p^.procdefinition^._class^.vmt_offset;
  1047. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
  1048. end;
  1049. { direct call to class constructor, don't allocate memory }
  1050. if is_con_or_destructor and
  1051. (p^.methodpointer^.resulttype^.deftype=objectdef) and
  1052. (pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  1053. exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,0)))
  1054. else
  1055. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  1056. if is_con_or_destructor then
  1057. begin
  1058. { classes don't get a VMT pointer pushed }
  1059. if (p^.methodpointer^.resulttype^.deftype=objectdef) and
  1060. not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  1061. begin
  1062. if ((p^.procdefinition^.options and poconstructor)<>0) then
  1063. begin
  1064. { it's no bad idea, to insert the VMT }
  1065. exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
  1066. newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,
  1067. 0))));
  1068. maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
  1069. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
  1070. end
  1071. { destructors haven't to dispose the instance, if this is }
  1072. { a direct call }
  1073. else
  1074. push_int(0);
  1075. end;
  1076. end;
  1077. end;
  1078. end;
  1079. end;
  1080. end
  1081. else
  1082. begin
  1083. if ((p^.procdefinition^.options and poclassmethod)<>0) and
  1084. not(
  1085. assigned(aktprocsym) and
  1086. ((aktprocsym^.definition^.options and poclassmethod)<>0)
  1087. ) then
  1088. begin
  1089. { class method needs current VMT }
  1090. new(r);
  1091. reset_reference(r^);
  1092. r^.base:=R_ESI;
  1093. r^.offset:= p^.procdefinition^._class^.vmt_offset;
  1094. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
  1095. end
  1096. else
  1097. begin
  1098. { member call, ESI isn't modified }
  1099. loadesi:=false;
  1100. end;
  1101. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  1102. { but a con- or destructor here would probably almost }
  1103. { always be placed wrong }
  1104. if is_con_or_destructor then
  1105. begin
  1106. CGMessage(cg_w_member_cd_call_from_method);
  1107. push_int(0);
  1108. end;
  1109. end;
  1110. end;
  1111. { push base pointer ?}
  1112. if (lexlevel>=normal_function_level) and assigned(pprocdef(p^.procdefinition)^.parast) and
  1113. ((p^.procdefinition^.parast^.symtablelevel)>normal_function_level) then
  1114. begin
  1115. { if we call a nested function in a method, we must }
  1116. { push also SELF! }
  1117. { THAT'S NOT TRUE, we have to load ESI via frame pointer }
  1118. { access }
  1119. {
  1120. begin
  1121. loadesi:=false;
  1122. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  1123. end;
  1124. }
  1125. if lexlevel=(p^.procdefinition^.parast^.symtablelevel) then
  1126. begin
  1127. new(r);
  1128. reset_reference(r^);
  1129. r^.offset:=procinfo.framepointer_offset;
  1130. r^.base:=procinfo.framepointer;
  1131. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,r)))
  1132. end
  1133. { this is only true if the difference is one !!
  1134. but it cannot be more !! }
  1135. else if (lexlevel=p^.procdefinition^.parast^.symtablelevel-1) then
  1136. begin
  1137. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,procinfo.framepointer)))
  1138. end
  1139. else if (lexlevel>p^.procdefinition^.parast^.symtablelevel) then
  1140. begin
  1141. hregister:=getregister32;
  1142. new(r);
  1143. reset_reference(r^);
  1144. r^.offset:=procinfo.framepointer_offset;
  1145. r^.base:=procinfo.framepointer;
  1146. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,hregister)));
  1147. for i:=(p^.procdefinition^.parast^.symtablelevel) to lexlevel-1 do
  1148. begin
  1149. new(r);
  1150. reset_reference(r^);
  1151. {we should get the correct frame_pointer_offset at each level
  1152. how can we do this !!! }
  1153. r^.offset:=procinfo.framepointer_offset;
  1154. r^.base:=hregister;
  1155. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,hregister)));
  1156. end;
  1157. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,hregister)));
  1158. ungetregister32(hregister);
  1159. end
  1160. else
  1161. internalerror(25000);
  1162. end;
  1163. if ((p^.procdefinition^.options and povirtualmethod)<>0) and
  1164. not(no_virtual_call) then
  1165. begin
  1166. { static functions contain the vmt_address in ESI }
  1167. { also class methods }
  1168. if assigned(aktprocsym) then
  1169. begin
  1170. if ((aktprocsym^.properties and sp_static)<>0) or
  1171. ((aktprocsym^.definition^.options and poclassmethod)<>0) or
  1172. ((p^.procdefinition^.options and postaticmethod)<>0) or
  1173. ((p^.procdefinition^.options and poconstructor)<>0) or
  1174. { ESI is loaded earlier }
  1175. ((p^.procdefinition^.options and poclassmethod)<>0)then
  1176. begin
  1177. new(r);
  1178. reset_reference(r^);
  1179. r^.base:=R_ESI;
  1180. end
  1181. else
  1182. begin
  1183. new(r);
  1184. reset_reference(r^);
  1185. r^.base:=R_ESI;
  1186. { this is one point where we need vmt_offset (PM) }
  1187. r^.offset:= p^.procdefinition^._class^.vmt_offset;
  1188. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
  1189. new(r);
  1190. reset_reference(r^);
  1191. r^.base:=R_EDI;
  1192. end;
  1193. end
  1194. else
  1195. { aktprocsym should be assigned, also in main program }
  1196. internalerror(12345);
  1197. {
  1198. begin
  1199. new(r);
  1200. reset_reference(r^);
  1201. r^.base:=R_ESI;
  1202. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
  1203. new(r);
  1204. reset_reference(r^);
  1205. r^.base:=R_EDI;
  1206. end;
  1207. }
  1208. if p^.procdefinition^.extnumber=-1 then
  1209. internalerror($Da);
  1210. r^.offset:=p^.procdefinition^.extnumber*4+12;
  1211. if (cs_check_range in aktlocalswitches) then
  1212. begin
  1213. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,r^.base)));
  1214. emitcall('FPC_CHECK_OBJECT',true);
  1215. end;
  1216. exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,r)));
  1217. end
  1218. else if not inlined then
  1219. emitcall(p^.procdefinition^.mangledname,
  1220. (p^.symtableproc^.symtabletype=unitsymtable) or
  1221. ((p^.symtableproc^.symtabletype=objectsymtable) and
  1222. (pobjectdef(p^.symtableproc^.defowner)^.owner^.symtabletype=unitsymtable))or
  1223. ((p^.symtableproc^.symtabletype=withsymtable) and
  1224. (pobjectdef(p^.symtableproc^.defowner)^.owner^.symtabletype=unitsymtable)))
  1225. else { inlined proc }
  1226. { inlined code is in inlinecode }
  1227. begin
  1228. secondpass(inlinecode);
  1229. { set poinline again }
  1230. p^.procdefinition^.options:=p^.procdefinition^.options or poinline;
  1231. { free the args }
  1232. ungetpersistanttemp(p^.procdefinition^.parast^.call_offset,
  1233. p^.procdefinition^.parast^.datasize);
  1234. end;
  1235. end
  1236. else
  1237. { now procedure variable case }
  1238. begin
  1239. secondpass(p^.right);
  1240. { method pointer ? }
  1241. if (p^.procdefinition^.options and pomethodpointer)<>0 then
  1242. begin
  1243. { method pointer can't be in a register }
  1244. inc(p^.right^.location.reference.offset,4);
  1245. { push self pointer }
  1246. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,newreference(p^.right^.location.reference))));
  1247. del_reference(p^.right^.location.reference);
  1248. dec(p^.right^.location.reference.offset,4);
  1249. end;
  1250. case p^.right^.location.loc of
  1251. LOC_REGISTER,LOC_CREGISTER:
  1252. begin
  1253. exprasmlist^.concat(new(pai386,op_reg(A_CALL,S_NO,p^.right^.location.register)));
  1254. ungetregister32(p^.right^.location.register);
  1255. end
  1256. else
  1257. exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,newreference(p^.right^.location.reference))));
  1258. del_reference(p^.right^.location.reference);
  1259. end;
  1260. end;
  1261. { this was only for normal functions
  1262. displaced here so we also get
  1263. it to work for procvars PM }
  1264. if (not inlined) and ((p^.procdefinition^.options and poclearstack)<>0) then
  1265. begin
  1266. { consider the alignment with the rest (PM) }
  1267. inc(pushedparasize,pop_size);
  1268. pop_size:=0;
  1269. { better than an add on all processors }
  1270. if pushedparasize=4 then
  1271. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)))
  1272. { the pentium has two pipes and pop reg is pairable }
  1273. { but the registers must be different! }
  1274. else if (pushedparasize=8) and
  1275. not(cs_littlesize in aktglobalswitches) and
  1276. (aktoptprocessor=ClassP5) and
  1277. (procinfo._class=nil) then
  1278. begin
  1279. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
  1280. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_ESI)));
  1281. end
  1282. else exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,pushedparasize,R_ESP)));
  1283. end;
  1284. dont_call:
  1285. pushedparasize:=oldpushedparasize;
  1286. unused:=unusedregisters;
  1287. { handle function results }
  1288. { structured results are easy to handle.... }
  1289. { needed also when result_no_used !! }
  1290. if (p^.resulttype<>pdef(voiddef)) and ret_in_param(p^.resulttype) then
  1291. begin
  1292. p^.location.loc:=LOC_MEM;
  1293. stringdispose(p^.location.reference.symbol);
  1294. p^.location.reference:=funcretref;
  1295. end;
  1296. if (p^.resulttype<>pdef(voiddef)) and p^.return_value_used then
  1297. begin
  1298. { a contructor could be a function with boolean result }
  1299. if (p^.right=nil) and
  1300. ((p^.procdefinition^.options and poconstructor)<>0) and
  1301. { quick'n'dirty check if it is a class or an object }
  1302. (p^.resulttype^.deftype=orddef) then
  1303. begin
  1304. p^.location.loc:=LOC_FLAGS;
  1305. p^.location.resflags:=F_NE;
  1306. if extended_new then
  1307. begin
  1308. {$ifdef test_dest_loc}
  1309. if dest_loc_known and (dest_loc_tree=p) then
  1310. mov_reg_to_dest(p,S_L,R_EAX)
  1311. else
  1312. {$endif test_dest_loc}
  1313. begin
  1314. hregister:=getexplicitregister32(R_EAX);
  1315. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1316. p^.location.register:=hregister;
  1317. end;
  1318. end;
  1319. end
  1320. { structed results are easy to handle.... }
  1321. else if ret_in_param(p^.resulttype) then
  1322. begin
  1323. {p^.location.loc:=LOC_MEM;
  1324. stringdispose(p^.location.reference.symbol);
  1325. p^.location.reference:=funcretref;
  1326. already done above (PM) }
  1327. end
  1328. else
  1329. begin
  1330. if (p^.resulttype^.deftype=orddef) then
  1331. begin
  1332. p^.location.loc:=LOC_REGISTER;
  1333. case porddef(p^.resulttype)^.typ of
  1334. s32bit,u32bit,bool32bit :
  1335. begin
  1336. {$ifdef test_dest_loc}
  1337. if dest_loc_known and (dest_loc_tree=p) then
  1338. mov_reg_to_dest(p,S_L,R_EAX)
  1339. else
  1340. {$endif test_dest_loc}
  1341. begin
  1342. hregister:=getexplicitregister32(R_EAX);
  1343. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1344. p^.location.register:=hregister;
  1345. end;
  1346. end;
  1347. uchar,u8bit,bool8bit,s8bit:
  1348. begin
  1349. {$ifdef test_dest_loc}
  1350. if dest_loc_known and (dest_loc_tree=p) then
  1351. mov_reg_to_dest(p,S_B,R_AL)
  1352. else
  1353. {$endif test_dest_loc}
  1354. begin
  1355. hregister:=getexplicitregister32(R_EAX);
  1356. emit_reg_reg(A_MOV,S_B,R_AL,reg32toreg8(hregister));
  1357. p^.location.register:=reg32toreg8(hregister);
  1358. end;
  1359. end;
  1360. s16bit,u16bit,bool16bit :
  1361. begin
  1362. {$ifdef test_dest_loc}
  1363. if dest_loc_known and (dest_loc_tree=p) then
  1364. mov_reg_to_dest(p,S_W,R_AX)
  1365. else
  1366. {$endif test_dest_loc}
  1367. begin
  1368. hregister:=getexplicitregister32(R_EAX);
  1369. emit_reg_reg(A_MOV,S_W,R_AX,reg32toreg16(hregister));
  1370. p^.location.register:=reg32toreg16(hregister);
  1371. end;
  1372. end;
  1373. s64bitint,u64bit:
  1374. begin
  1375. {$ifdef test_dest_loc}
  1376. {$error Don't know what to do here}
  1377. {$endif test_dest_loc}
  1378. hregister:=getexplicitregister32(R_EAX);
  1379. hregister2:=getexplicitregister32(R_EDX);
  1380. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1381. emit_reg_reg(A_MOV,S_L,R_EDX,hregister2);
  1382. p^.location.registerlow:=hregister;
  1383. p^.location.registerhigh:=hregister2;
  1384. end;
  1385. else internalerror(7);
  1386. end
  1387. end
  1388. else if (p^.resulttype^.deftype=floatdef) then
  1389. case pfloatdef(p^.resulttype)^.typ of
  1390. f32bit:
  1391. begin
  1392. p^.location.loc:=LOC_REGISTER;
  1393. {$ifdef test_dest_loc}
  1394. if dest_loc_known and (dest_loc_tree=p) then
  1395. mov_reg_to_dest(p,S_L,R_EAX)
  1396. else
  1397. {$endif test_dest_loc}
  1398. begin
  1399. hregister:=getexplicitregister32(R_EAX);
  1400. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1401. p^.location.register:=hregister;
  1402. end;
  1403. end;
  1404. else
  1405. p^.location.loc:=LOC_FPU;
  1406. end
  1407. else
  1408. begin
  1409. p^.location.loc:=LOC_REGISTER;
  1410. {$ifdef test_dest_loc}
  1411. if dest_loc_known and (dest_loc_tree=p) then
  1412. mov_reg_to_dest(p,S_L,R_EAX)
  1413. else
  1414. {$endif test_dest_loc}
  1415. begin
  1416. hregister:=getexplicitregister32(R_EAX);
  1417. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1418. p^.location.register:=hregister;
  1419. if is_ansistring(p^.resulttype) or
  1420. is_widestring(p^.resulttype) then
  1421. begin
  1422. gettempansistringreference(hr);
  1423. {temptoremove^.concat(new(ptemptodestroy,init(hr,p^.resulttype)));}
  1424. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,p^.location.register,
  1425. newreference(hr))));
  1426. end;
  1427. end;
  1428. end;
  1429. end;
  1430. end;
  1431. { perhaps i/o check ? }
  1432. if iolabel<>nil then
  1433. begin
  1434. exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,newcsymbol(lab2str(iolabel),0))));
  1435. emitcall('FPC_IOCHECK',true);
  1436. end;
  1437. if pop_size>0 then
  1438. exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,pop_size,R_ESP)));
  1439. { restore registers }
  1440. popusedregisters(pushed);
  1441. { at last, restore instance pointer (SELF) }
  1442. if loadesi then
  1443. maybe_loadesi;
  1444. pp:=params;
  1445. while assigned(pp) do
  1446. begin
  1447. if assigned(pp^.left) then
  1448. begin
  1449. if pp^.left^.location.loc in [LOC_REFERENCE,LOC_MEM] then
  1450. ungetiftemp(pp^.left^.location.reference);
  1451. { process also all nodes of an array of const }
  1452. if pp^.left^.treetype=arrayconstructn then
  1453. begin
  1454. if assigned(pp^.left^.left) then
  1455. begin
  1456. hp:=pp^.left;
  1457. while assigned(hp) do
  1458. begin
  1459. if hp^.left^.location.loc in [LOC_REFERENCE,LOC_MEM] then
  1460. ungetiftemp(hp^.left^.location.reference);
  1461. hp:=hp^.right;
  1462. end;
  1463. end;
  1464. end;
  1465. end;
  1466. pp:=pp^.right;
  1467. end;
  1468. if inlined then
  1469. ungetpersistanttemp(inlinecode^.retoffset,4);
  1470. disposetree(params);
  1471. { from now on the result can be freed normally }
  1472. if inlined and ret_in_param(p^.resulttype) then
  1473. persistanttemptonormal(funcretref.offset);
  1474. { if return value is not used }
  1475. if (not p^.return_value_used) and (p^.resulttype<>pdef(voiddef)) then
  1476. begin
  1477. if p^.location.loc in [LOC_MEM,LOC_REFERENCE] then
  1478. { release unused temp }
  1479. ungetiftemp(p^.location.reference)
  1480. else if p^.location.loc=LOC_FPU then
  1481. { release FPU stack }
  1482. exprasmlist^.concat(new(pai386,op_none(A_FDECSTP,S_NO)));
  1483. end;
  1484. end;
  1485. {*****************************************************************************
  1486. SecondProcInlineN
  1487. *****************************************************************************}
  1488. { implementation not complete yet }
  1489. var
  1490. addr_correction : longint;
  1491. procedure correct_address(p : psym);{$ifndef FPC}far;{$endif}
  1492. begin
  1493. if p^.typ=varsym then
  1494. begin
  1495. inc(pvarsym(p)^.address,addr_correction);
  1496. {$ifdef extdebug}
  1497. Comment(V_debug,pvarsym(p)^.name+' is at offset -'
  1498. +tostr(pvarsym(p)^.address));
  1499. exprasmlist^.concat(new(pai_asm_comment,init(
  1500. strpnew(pvarsym(p)^.name+' is at offset -'
  1501. +tostr(pvarsym(p)^.address)))));
  1502. {$endif extdebug}
  1503. end;
  1504. end;
  1505. procedure secondprocinline(var p : ptree);
  1506. var st : psymtable;
  1507. oldprocsym : pprocsym;
  1508. para_size : longint;
  1509. oldprocinfo : tprocinfo;
  1510. { just dummies for genentrycode }
  1511. nostackframe,make_global : boolean;
  1512. proc_names : tstringcontainer;
  1513. inlineentrycode,inlineexitcode : paasmoutput;
  1514. oldexitlabel,oldexit2label,oldquickexitlabel:Plabel;
  1515. begin
  1516. oldexitlabel:=aktexitlabel;
  1517. oldexit2label:=aktexit2label;
  1518. oldquickexitlabel:=quickexitlabel;
  1519. getlabel(aktexitlabel);
  1520. getlabel(aktexit2label);
  1521. oldprocsym:=aktprocsym;
  1522. oldprocinfo:=procinfo;
  1523. { set the return value }
  1524. procinfo.retdef:=p^.inlineprocdef^.retdef;
  1525. procinfo.retoffset:=p^.retoffset;
  1526. { arg space has been filled by the parent secondcall }
  1527. st:=p^.inlineprocdef^.localst;
  1528. { set it to the same lexical level }
  1529. st^.symtablelevel:=
  1530. oldprocsym^.definition^.localst^.symtablelevel;
  1531. if st^.datasize>0 then
  1532. st^.call_offset:=gettempofsizepersistant(st^.datasize);
  1533. {$ifdef extdebug}
  1534. Comment(V_debug,'local symtable is at offset '
  1535. +tostr(st^.call_offset));
  1536. exprasmlist^.concat(new(pai_asm_comment,init(
  1537. strpnew('local symtable is at offset '
  1538. +tostr(st^.call_offset)))));
  1539. {$endif extdebug}
  1540. addr_correction:=-st^.call_offset-st^.datasize;
  1541. st^.foreach(correct_address);
  1542. {$ifdef extdebug}
  1543. exprasmlist^.concat(new(pai_asm_comment,init('Start of inlined proc')));
  1544. {$endif extdebug}
  1545. { takes care of local data initialization }
  1546. inlineentrycode:=new(paasmoutput,init);
  1547. inlineexitcode:=new(paasmoutput,init);
  1548. proc_names.init;
  1549. para_size:=p^.para_size;
  1550. make_global:=false; { to avoid warning }
  1551. genentrycode(inlineentrycode,proc_names,make_global,0,para_size,nostackframe,true);
  1552. exprasmlist^.concatlist(inlineentrycode);
  1553. secondpass(p^.left);
  1554. genexitcode(inlineexitcode,0,false,true);
  1555. exprasmlist^.concatlist(inlineexitcode);
  1556. {$ifdef extdebug}
  1557. exprasmlist^.concat(new(pai_asm_comment,init('End of inlined proc')));
  1558. {$endif extdebug}
  1559. {we can free the local data now }
  1560. if st^.datasize>0 then
  1561. ungetpersistanttemp(st^.call_offset,st^.datasize);
  1562. { set the real address again }
  1563. addr_correction:=-addr_correction;
  1564. st^.foreach(correct_address);
  1565. aktprocsym:=oldprocsym;
  1566. freelabel(aktexitlabel);
  1567. freelabel(aktexit2label);
  1568. aktexitlabel:=oldexitlabel;
  1569. aktexit2label:=oldexit2label;
  1570. quickexitlabel:=oldquickexitlabel;
  1571. procinfo:=oldprocinfo;
  1572. end;
  1573. end.
  1574. {
  1575. $Log$
  1576. Revision 1.53 1998-12-11 00:02:47 peter
  1577. + globtype,tokens,version unit splitted from globals
  1578. Revision 1.52 1998/12/10 14:39:29 florian
  1579. * bug with p(const a : ansistring) fixed
  1580. * duplicate constant ansistrings were handled wrong, fixed
  1581. Revision 1.51 1998/12/10 09:47:15 florian
  1582. + basic operations with int64/qord (compiler with -dint64)
  1583. + rtti of enumerations extended: names are now written
  1584. Revision 1.50 1998/12/06 13:12:44 florian
  1585. * better code generation for classes which are passed as parameters to
  1586. subroutines
  1587. Revision 1.49 1998/11/30 09:43:00 pierre
  1588. * some range check bugs fixed (still not working !)
  1589. + added DLL writing support for win32 (also accepts variables)
  1590. + TempAnsi for code that could be used for Temporary ansi strings
  1591. handling
  1592. Revision 1.48 1998/11/27 14:50:30 peter
  1593. + open strings, $P switch support
  1594. Revision 1.47 1998/11/26 21:30:03 peter
  1595. * fix for valuepara
  1596. Revision 1.46 1998/11/26 14:39:10 peter
  1597. * ansistring -> pchar fixed
  1598. * ansistring constants fixed
  1599. * ansistring constants are now written once
  1600. Revision 1.45 1998/11/18 15:44:07 peter
  1601. * VALUEPARA for tp7 compatible value parameters
  1602. Revision 1.44 1998/11/16 15:35:36 peter
  1603. * rename laod/copystring -> load/copyshortstring
  1604. * fixed int-bool cnv bug
  1605. + char-ansistring conversion
  1606. Revision 1.43 1998/11/15 16:32:33 florian
  1607. * some stuff of Pavel implement (win32 dll creation)
  1608. * bug with ansistring function results fixed
  1609. Revision 1.42 1998/11/13 15:40:13 pierre
  1610. + added -Se in Makefile cvstest target
  1611. + lexlevel cleanup
  1612. normal_function_level main_program_level and unit_init_level defined
  1613. * tins_cache grown to A_EMMS (gave range check error in asm readers)
  1614. (test added in code !)
  1615. * -Un option was wrong
  1616. * _FAIL and _SELF only keyword inside
  1617. constructors and methods respectively
  1618. Revision 1.41 1998/11/12 11:19:40 pierre
  1619. * fix for first line of function break
  1620. Revision 1.40 1998/11/10 10:09:08 peter
  1621. * va_list -> array of const
  1622. Revision 1.39 1998/11/09 11:44:33 peter
  1623. + va_list for printf support
  1624. Revision 1.38 1998/10/21 15:12:49 pierre
  1625. * bug fix for IOCHECK inside a procedure with iocheck modifier
  1626. * removed the GPF for unexistant overloading
  1627. (firstcall was called with procedinition=nil !)
  1628. * changed typen to what Florian proposed
  1629. gentypenode(p : pdef) sets the typenodetype field
  1630. and resulttype is only set if inside bt_type block !
  1631. Revision 1.37 1998/10/21 08:39:57 florian
  1632. + ansistring operator +
  1633. + $h and string[n] for n>255 added
  1634. * small problem with TP fixed
  1635. Revision 1.36 1998/10/20 08:06:39 pierre
  1636. * several memory corruptions due to double freemem solved
  1637. => never use p^.loc.location:=p^.left^.loc.location;
  1638. + finally I added now by default
  1639. that ra386dir translates global and unit symbols
  1640. + added a first field in tsymtable and
  1641. a nextsym field in tsym
  1642. (this allows to obtain ordered type info for
  1643. records and objects in gdb !)
  1644. Revision 1.35 1998/10/16 08:51:45 peter
  1645. + target_os.stackalignment
  1646. + stack can be aligned at 2 or 4 byte boundaries
  1647. Revision 1.34 1998/10/09 08:56:22 pierre
  1648. * several memory leaks fixed
  1649. Revision 1.33 1998/10/06 17:16:39 pierre
  1650. * some memory leaks fixed (thanks to Peter for heaptrc !)
  1651. Revision 1.32 1998/10/01 09:22:52 peter
  1652. * fixed value openarray
  1653. * ungettemp of arrayconstruct
  1654. Revision 1.31 1998/09/28 16:57:15 pierre
  1655. * changed all length(p^.value_str^) into str_length(p)
  1656. to get it work with and without ansistrings
  1657. * changed sourcefiles field of tmodule to a pointer
  1658. Revision 1.30 1998/09/26 15:03:02 florian
  1659. * small problems with DOM and excpetions fixed (code generation
  1660. of raise was wrong and self was sometimes destroyed :()
  1661. Revision 1.29 1998/09/25 00:04:00 florian
  1662. * problems when calling class methods fixed
  1663. Revision 1.28 1998/09/24 14:27:37 peter
  1664. * some better support for openarray
  1665. Revision 1.27 1998/09/24 09:02:13 peter
  1666. * rewritten isconvertable to use case
  1667. * array of .. and single variable are compatible
  1668. Revision 1.26 1998/09/21 08:45:06 pierre
  1669. + added vmt_offset in tobjectdef.write for fututre use
  1670. (first steps to have objects without vmt if no virtual !!)
  1671. + added fpu_used field for tabstractprocdef :
  1672. sets this level to 2 if the functions return with value in FPU
  1673. (is then set to correct value at parsing of implementation)
  1674. THIS MIGHT refuse some code with FPU expression too complex
  1675. that were accepted before and even in some cases
  1676. that don't overflow in fact
  1677. ( like if f : float; is a forward that finally in implementation
  1678. only uses one fpu register !!)
  1679. Nevertheless I think that it will improve security on
  1680. FPU operations !!
  1681. * most other changes only for UseBrowser code
  1682. (added symtable references for record and objects)
  1683. local switch for refs to args and local of each function
  1684. (static symtable still missing)
  1685. UseBrowser still not stable and probably broken by
  1686. the definition hash array !!
  1687. Revision 1.25 1998/09/20 12:26:35 peter
  1688. * merged fixes
  1689. Revision 1.24 1998/09/17 09:42:10 peter
  1690. + pass_2 for cg386
  1691. * Message() -> CGMessage() for pass_1/pass_2
  1692. Revision 1.23 1998/09/14 10:43:45 peter
  1693. * all internal RTL functions start with FPC_
  1694. Revision 1.22.2.1 1998/09/20 12:20:06 peter
  1695. * Fixed stack not on 4 byte boundary when doing a call
  1696. Revision 1.22 1998/09/04 08:41:37 peter
  1697. * updated some error CGMessages
  1698. Revision 1.21 1998/09/01 12:47:57 peter
  1699. * use pdef^.size instead of orddef^.typ
  1700. Revision 1.20 1998/08/31 12:22:15 peter
  1701. * secondinline moved to cg386inl
  1702. Revision 1.19 1998/08/31 08:52:03 peter
  1703. * fixed error 10 with succ() and pref()
  1704. Revision 1.18 1998/08/20 21:36:38 peter
  1705. * fixed 'with object do' bug
  1706. Revision 1.17 1998/08/19 16:07:36 jonas
  1707. * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
  1708. Revision 1.16 1998/08/18 09:24:36 pierre
  1709. * small warning position bug fixed
  1710. * support_mmx switches splitting was missing
  1711. * rhide error and warning output corrected
  1712. Revision 1.15 1998/08/13 11:00:09 peter
  1713. * fixed procedure<>procedure construct
  1714. Revision 1.14 1998/08/11 14:05:33 peter
  1715. * fixed sizeof(array of char)
  1716. Revision 1.13 1998/08/10 14:49:45 peter
  1717. + localswitches, moduleswitches, globalswitches splitting
  1718. Revision 1.12 1998/07/30 13:30:31 florian
  1719. * final implemenation of exception support, maybe it needs
  1720. some fixes :)
  1721. Revision 1.11 1998/07/24 22:16:52 florian
  1722. * internal error 10 together with array access fixed. I hope
  1723. that's the final fix.
  1724. Revision 1.10 1998/07/18 22:54:23 florian
  1725. * some ansi/wide/longstring support fixed:
  1726. o parameter passing
  1727. o returning as result from functions
  1728. Revision 1.9 1998/07/07 17:40:37 peter
  1729. * packrecords 4 works
  1730. * word aligning of parameters
  1731. Revision 1.8 1998/07/06 15:51:15 michael
  1732. Added length checking for string reading
  1733. Revision 1.7 1998/07/06 14:19:51 michael
  1734. + Added calls for reading/writing ansistrings
  1735. Revision 1.6 1998/07/01 15:28:48 peter
  1736. + better writeln/readln handling, now 100% like tp7
  1737. Revision 1.5 1998/06/25 14:04:17 peter
  1738. + internal inc/dec
  1739. Revision 1.4 1998/06/25 08:48:06 florian
  1740. * first version of rtti support
  1741. Revision 1.3 1998/06/09 16:01:33 pierre
  1742. + added procedure directive parsing for procvars
  1743. (accepted are popstack cdecl and pascal)
  1744. + added C vars with the following syntax
  1745. var C calias 'true_c_name';(can be followed by external)
  1746. reason is that you must add the Cprefix
  1747. which is target dependent
  1748. Revision 1.2 1998/06/08 13:13:29 pierre
  1749. + temporary variables now in temp_gen.pas unit
  1750. because it is processor independent
  1751. * mppc68k.bat modified to undefine i386 and support_mmx
  1752. (which are defaults for i386)
  1753. Revision 1.1 1998/06/05 17:44:10 peter
  1754. * splitted cgi386
  1755. }