cg386cal.pas 107 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 by Florian Klaempfl
  4. Generate i386 assembler for in call/inline 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. procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
  23. push_from_left_to_right,inlined : boolean;para_offset : longint);
  24. procedure secondcalln(var p : ptree);
  25. procedure secondinline(var p : ptree);
  26. procedure secondprocinline(var p : ptree);
  27. implementation
  28. uses
  29. cobjects,verbose,globals,systems,
  30. aasm,i386,types,
  31. cgi386,cgai386,temp_gen,tgeni386,hcodegen,
  32. cg386ld;
  33. {*****************************************************************************
  34. SecondCallParaN
  35. *****************************************************************************}
  36. { save the size of pushed parameter }
  37. var
  38. pushedparasize : longint;
  39. procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
  40. push_from_left_to_right,inlined : boolean;para_offset : longint);
  41. procedure maybe_push_open_array_high;
  42. var
  43. r : preference;
  44. begin
  45. { open array ? }
  46. { defcoll^.data can be nil for read/write }
  47. if assigned(defcoll^.data) and
  48. is_open_array(defcoll^.data) then
  49. begin
  50. inc(pushedparasize,4);
  51. { push high }
  52. if is_open_array(p^.left^.resulttype) then
  53. begin
  54. r:=new_reference(highframepointer,highoffset+4);
  55. if inlined then
  56. begin
  57. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
  58. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  59. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  60. end
  61. else
  62. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,r)));
  63. end
  64. else
  65. begin
  66. if inlined then
  67. begin
  68. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  69. exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_L,
  70. parraydef(p^.left^.resulttype)^.highrange-
  71. parraydef(p^.left^.resulttype)^.lowrange,r)));
  72. end
  73. else
  74. push_int(parraydef(p^.left^.resulttype)^.highrange-
  75. parraydef(p^.left^.resulttype)^.lowrange);
  76. end;
  77. end;
  78. end;
  79. var
  80. size : longint;
  81. stackref : treference;
  82. otlabel,hlabel,oflabel : plabel;
  83. { temporary variables: }
  84. tempdeftype : tdeftype;
  85. tempreference : treference;
  86. r : preference;
  87. s : topsize;
  88. op : tasmop;
  89. begin
  90. { push from left to right if specified }
  91. if push_from_left_to_right and assigned(p^.right) then
  92. secondcallparan(p^.right,defcoll^.next,push_from_left_to_right,inlined,para_offset);
  93. otlabel:=truelabel;
  94. oflabel:=falselabel;
  95. getlabel(truelabel);
  96. getlabel(falselabel);
  97. secondpass(p^.left);
  98. { in codegen.handleread.. defcoll^.data is set to nil }
  99. if assigned(defcoll^.data) and
  100. (defcoll^.data^.deftype=formaldef) then
  101. begin
  102. { allow @var }
  103. inc(pushedparasize,4);
  104. if p^.left^.treetype=addrn then
  105. begin
  106. { always a register }
  107. if inlined then
  108. begin
  109. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  110. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
  111. p^.left^.location.register,r)));
  112. end
  113. else
  114. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
  115. ungetregister32(p^.left^.location.register);
  116. end
  117. else
  118. begin
  119. if not(p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
  120. Message(sym_e_type_mismatch)
  121. else
  122. begin
  123. if inlined then
  124. begin
  125. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  126. newreference(p^.left^.location.reference),R_EDI)));
  127. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  128. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  129. end
  130. else
  131. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  132. del_reference(p^.left^.location.reference);
  133. end;
  134. end;
  135. end
  136. { handle call by reference parameter }
  137. else if (defcoll^.paratyp=vs_var) then
  138. begin
  139. if (p^.left^.location.loc<>LOC_REFERENCE) then
  140. Message(cg_e_var_must_be_reference);
  141. maybe_push_open_array_high;
  142. inc(pushedparasize,4);
  143. if inlined then
  144. begin
  145. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  146. newreference(p^.left^.location.reference),R_EDI)));
  147. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  148. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  149. end
  150. else
  151. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  152. del_reference(p^.left^.location.reference);
  153. end
  154. else
  155. begin
  156. tempdeftype:=p^.resulttype^.deftype;
  157. if tempdeftype=filedef then
  158. Message(cg_e_file_must_call_by_reference);
  159. if (defcoll^.paratyp=vs_const) and
  160. dont_copy_const_param(p^.resulttype) then
  161. begin
  162. maybe_push_open_array_high;
  163. inc(pushedparasize,4);
  164. if inlined then
  165. begin
  166. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  167. newreference(p^.left^.location.reference),R_EDI)));
  168. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  169. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
  170. R_EDI,r)));
  171. end
  172. else
  173. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  174. del_reference(p^.left^.location.reference);
  175. end
  176. else
  177. case p^.left^.location.loc of
  178. LOC_REGISTER,
  179. LOC_CREGISTER:
  180. begin
  181. case p^.left^.location.register of
  182. R_EAX,R_EBX,R_ECX,R_EDX,R_ESI,
  183. R_EDI,R_ESP,R_EBP :
  184. begin
  185. inc(pushedparasize,4);
  186. if inlined then
  187. begin
  188. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  189. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
  190. p^.left^.location.register,r)));
  191. end
  192. else
  193. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
  194. ungetregister32(p^.left^.location.register);
  195. end;
  196. R_AX,R_BX,R_CX,R_DX,R_SI,R_DI:
  197. begin
  198. inc(pushedparasize,2);
  199. if inlined then
  200. begin
  201. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  202. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_W,
  203. p^.left^.location.register,r)));
  204. end
  205. else
  206. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_W,p^.left^.location.register)));
  207. ungetregister32(reg16toreg32(p^.left^.location.register));
  208. end;
  209. R_AL,R_BL,R_CL,R_DL:
  210. begin
  211. inc(pushedparasize,2);
  212. { we must push always 16 bit }
  213. if inlined then
  214. begin
  215. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  216. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
  217. reg8toreg16(p^.left^.location.register),r)));
  218. end
  219. else
  220. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_W,
  221. reg8toreg16(p^.left^.location.register))));
  222. ungetregister32(reg8toreg32(p^.left^.location.register));
  223. end;
  224. end;
  225. end;
  226. LOC_FPU:
  227. begin
  228. size:=pfloatdef(p^.left^.resulttype)^.size;
  229. inc(pushedparasize,size); { must be before for inlined }
  230. if not inlined then
  231. exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,S_L,size,R_ESP)));
  232. r:=new_reference(R_ESP,0);
  233. floatstoreops(pfloatdef(p^.left^.resulttype)^.typ,op,s);
  234. { this is the easiest case for inlined !! }
  235. if inlined then
  236. begin
  237. r^.base:=procinfo.framepointer;
  238. r^.offset:=para_offset-pushedparasize;
  239. end;
  240. exprasmlist^.concat(new(pai386,op_ref(op,s,r)));
  241. end;
  242. LOC_REFERENCE,LOC_MEM:
  243. begin
  244. tempreference:=p^.left^.location.reference;
  245. del_reference(p^.left^.location.reference);
  246. case p^.resulttype^.deftype of
  247. orddef :
  248. begin
  249. case porddef(p^.resulttype)^.typ of
  250. s32bit,u32bit,bool32bit :
  251. begin
  252. inc(pushedparasize,4);
  253. if inlined then
  254. begin
  255. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  256. newreference(tempreference),R_EDI)));
  257. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  258. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  259. end
  260. else
  261. emit_push_mem(tempreference);
  262. end;
  263. s8bit,u8bit,uchar,bool8bit,
  264. bool16bit,s16bit,u16bit :
  265. begin
  266. inc(pushedparasize,2);
  267. if inlined then
  268. begin
  269. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_W,
  270. newreference(tempreference),R_DI)));
  271. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  272. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_W,R_DI,r)));
  273. end
  274. else
  275. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_W,
  276. newreference(tempreference))));
  277. end;
  278. end;
  279. end;
  280. floatdef :
  281. begin
  282. case pfloatdef(p^.resulttype)^.typ of
  283. f32bit,
  284. s32real :
  285. begin
  286. inc(pushedparasize,4);
  287. if inlined then
  288. begin
  289. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  290. newreference(tempreference),R_EDI)));
  291. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  292. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  293. end
  294. else
  295. emit_push_mem(tempreference);
  296. end;
  297. s64real,
  298. s64bit :
  299. begin
  300. inc(pushedparasize,4);
  301. inc(tempreference.offset,4);
  302. if inlined then
  303. begin
  304. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  305. newreference(tempreference),R_EDI)));
  306. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  307. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  308. end
  309. else
  310. emit_push_mem(tempreference);
  311. inc(pushedparasize,4);
  312. dec(tempreference.offset,4);
  313. if inlined then
  314. begin
  315. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  316. newreference(tempreference),R_EDI)));
  317. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  318. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  319. end
  320. else
  321. emit_push_mem(tempreference);
  322. end;
  323. s80real :
  324. begin
  325. inc(pushedparasize,4);
  326. inc(tempreference.offset,6);
  327. if inlined then
  328. begin
  329. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  330. newreference(tempreference),R_EDI)));
  331. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  332. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  333. end
  334. else
  335. emit_push_mem(tempreference);
  336. dec(tempreference.offset,4);
  337. inc(pushedparasize,4);
  338. if inlined then
  339. begin
  340. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  341. newreference(tempreference),R_EDI)));
  342. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  343. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  344. end
  345. else
  346. emit_push_mem(tempreference);
  347. dec(tempreference.offset,2);
  348. inc(pushedparasize,2);
  349. if inlined then
  350. begin
  351. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_W,
  352. newreference(tempreference),R_DI)));
  353. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  354. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_W,R_DI,r)));
  355. end
  356. else
  357. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_W,
  358. newreference(tempreference))));
  359. end;
  360. end;
  361. end;
  362. pointerdef,procvardef,
  363. enumdef,classrefdef:
  364. begin
  365. inc(pushedparasize,4);
  366. if inlined then
  367. begin
  368. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  369. newreference(tempreference),R_EDI)));
  370. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  371. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
  372. end
  373. else
  374. emit_push_mem(tempreference);
  375. end;
  376. arraydef,recorddef,stringdef,setdef,objectdef :
  377. begin
  378. { 32 bit type set ? }
  379. if is_widestring(p^.resulttype) or
  380. is_ansistring(p^.resulttype) or
  381. ((p^.resulttype^.deftype=setdef) and
  382. (psetdef(p^.resulttype)^.settype=smallset)) then
  383. begin
  384. inc(pushedparasize,4);
  385. if inlined then
  386. begin
  387. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  388. concatcopy(tempreference,r^,4,false);
  389. end
  390. else
  391. emit_push_mem(tempreference);
  392. end
  393. { call by value open array ? }
  394. else
  395. if (p^.resulttype^.deftype=arraydef) and
  396. assigned(defcoll^.data) and
  397. is_open_array(defcoll^.data) then
  398. begin
  399. { first, push high }
  400. maybe_push_open_array_high;
  401. inc(pushedparasize,4);
  402. if inlined then
  403. begin
  404. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  405. newreference(p^.left^.location.reference),R_EDI)));
  406. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  407. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
  408. R_EDI,r)));
  409. end
  410. else
  411. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  412. end
  413. else
  414. begin
  415. size:=p^.resulttype^.size;
  416. { Word Alignment }
  417. if Odd(size) then
  418. inc(size);
  419. { create stack space }
  420. if not inlined then
  421. exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,S_L,size,R_ESP)));
  422. inc(pushedparasize,size);
  423. { create stack reference }
  424. stackref.symbol := nil;
  425. if not inlined then
  426. begin
  427. clear_reference(stackref);
  428. stackref.base:=R_ESP;
  429. end
  430. else
  431. begin
  432. clear_reference(stackref);
  433. stackref.base:=procinfo.framepointer;
  434. stackref.offset:=para_offset-pushedparasize;
  435. end;
  436. { generate copy }
  437. if is_shortstring(p^.resulttype) then
  438. begin
  439. copystring(stackref,p^.left^.location.reference,
  440. pstringdef(p^.resulttype)^.len);
  441. end
  442. else
  443. begin
  444. concatcopy(p^.left^.location.reference,
  445. stackref,p^.resulttype^.size,true);
  446. end;
  447. end;
  448. end;
  449. else
  450. Message(cg_e_illegal_expression);
  451. end;
  452. end;
  453. LOC_JUMP:
  454. begin
  455. getlabel(hlabel);
  456. inc(pushedparasize,2);
  457. emitl(A_LABEL,truelabel);
  458. if inlined then
  459. begin
  460. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  461. exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_W,1,r)));
  462. end
  463. else
  464. exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_W,1)));
  465. emitl(A_JMP,hlabel);
  466. emitl(A_LABEL,falselabel);
  467. if inlined then
  468. begin
  469. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  470. exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_W,0,r)));
  471. end
  472. else
  473. exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_W,0)));
  474. emitl(A_LABEL,hlabel);
  475. end;
  476. LOC_FLAGS:
  477. begin
  478. if not(R_EAX in unused) then
  479. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,R_EAX,R_EDI)));
  480. { clear full EAX is faster }
  481. { but dont you set the equal flag ? }
  482. {exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_EAX,R_EAX)));}
  483. exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.left^.location.resflags],S_B,
  484. R_AL)));
  485. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BW,R_AL,R_AX)));
  486. {exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_EAX,R_EAX)));}
  487. inc(pushedparasize,2);
  488. if inlined then
  489. begin
  490. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  491. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_W,
  492. R_AX,r)));
  493. end
  494. else
  495. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_W,R_AX)));
  496. { this is also false !!!
  497. if not(R_EAX in unused) then
  498. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,R_EAX,R_EDI)));}
  499. if not(R_EAX in unused) then
  500. exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,R_EDI,R_EAX)));
  501. end;
  502. {$ifdef SUPPORT_MMX}
  503. LOC_MMXREGISTER,
  504. LOC_CMMXREGISTER:
  505. begin
  506. inc(pushedparasize,8); { was missing !!! (PM) }
  507. exprasmlist^.concat(new(pai386,op_const_reg(
  508. A_SUB,S_L,8,R_ESP)));
  509. if inlined then
  510. begin
  511. r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
  512. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOVQ,S_NO,
  513. p^.left^.location.register,r)));
  514. end
  515. else
  516. begin
  517. r:=new_reference(R_ESP,0);
  518. exprasmlist^.concat(new(pai386,op_reg_ref(
  519. A_MOVQ,S_NO,p^.left^.location.register,r)));
  520. end;
  521. end;
  522. {$endif SUPPORT_MMX}
  523. end;
  524. end;
  525. truelabel:=otlabel;
  526. falselabel:=oflabel;
  527. { push from right to left }
  528. if not push_from_left_to_right and assigned(p^.right) then
  529. secondcallparan(p^.right,defcoll^.next,push_from_left_to_right,inlined,para_offset);
  530. end;
  531. {*****************************************************************************
  532. SecondCallN
  533. *****************************************************************************}
  534. procedure secondcalln(var p : ptree);
  535. var
  536. unusedregisters : tregisterset;
  537. pushed : tpushed;
  538. funcretref : treference;
  539. hregister : tregister;
  540. oldpushedparasize : longint;
  541. { true if ESI must be loaded again after the subroutine }
  542. loadesi : boolean;
  543. { true if a virtual method must be called directly }
  544. no_virtual_call : boolean;
  545. { true if we produce a con- or destrutor in a call }
  546. is_con_or_destructor : boolean;
  547. { true if a constructor is called again }
  548. extended_new : boolean;
  549. { adress returned from an I/O-error }
  550. iolabel : plabel;
  551. { lexlevel count }
  552. i : longint;
  553. { help reference pointer }
  554. r : preference;
  555. pp,params : ptree;
  556. inlined : boolean;
  557. inlinecode : ptree;
  558. para_offset : longint;
  559. { instruction for alignement correction }
  560. corr : pai386;
  561. { we must pop this size also after !! }
  562. must_pop : boolean;
  563. pop_size : longint;
  564. label
  565. dont_call;
  566. begin
  567. extended_new:=false;
  568. iolabel:=nil;
  569. inlinecode:=nil;
  570. inlined:=false;
  571. loadesi:=true;
  572. no_virtual_call:=false;
  573. unusedregisters:=unused;
  574. if not assigned(p^.procdefinition) then
  575. exit;
  576. if (p^.procdefinition^.options and poinline)<>0 then
  577. begin
  578. inlined:=true;
  579. inlinecode:=p^.right;
  580. { set it to the same lexical level }
  581. p^.procdefinition^.parast^.symtablelevel:=
  582. aktprocsym^.definition^.parast^.symtablelevel;
  583. if assigned(p^.left) then
  584. inlinecode^.para_offset:=
  585. gettempofsizepersistant(inlinecode^.para_size);
  586. p^.procdefinition^.parast^.call_offset:=
  587. inlinecode^.para_offset;
  588. {$ifdef extdebug}
  589. Comment(V_debug,
  590. 'inlined parasymtable is at offset '
  591. +tostr(p^.procdefinition^.parast^.call_offset));
  592. exprasmlist^.concat(new(pai_asm_comment,init(
  593. strpnew('inlined parasymtable is at offset '
  594. +tostr(p^.procdefinition^.parast^.call_offset)))));
  595. {$endif extdebug}
  596. p^.right:=nil;
  597. { disable further inlining of the same proc
  598. in the args }
  599. p^.procdefinition^.options:=p^.procdefinition^.options and (not poinline);
  600. end;
  601. { only if no proc var }
  602. if not(assigned(p^.right)) then
  603. is_con_or_destructor:=((p^.procdefinition^.options and poconstructor)<>0)
  604. or ((p^.procdefinition^.options and podestructor)<>0);
  605. { proc variables destroy all registers }
  606. if (p^.right=nil) and
  607. { virtual methods too }
  608. ((p^.procdefinition^.options and povirtualmethod)=0) then
  609. begin
  610. if ((p^.procdefinition^.options and poiocheck)<>0) and
  611. (cs_check_io in aktlocalswitches) then
  612. begin
  613. getlabel(iolabel);
  614. emitl(A_LABEL,iolabel);
  615. end
  616. else
  617. iolabel:=nil;
  618. { save all used registers }
  619. pushusedregisters(pushed,p^.procdefinition^.usedregisters);
  620. { give used registers through }
  621. usedinproc:=usedinproc or p^.procdefinition^.usedregisters;
  622. end
  623. else
  624. begin
  625. pushusedregisters(pushed,$ff);
  626. usedinproc:=$ff;
  627. { no IO check for methods and procedure variables }
  628. iolabel:=nil;
  629. end;
  630. { generate the code for the parameter and push them }
  631. oldpushedparasize:=pushedparasize;
  632. pushedparasize:=0;
  633. corr:=new(pai386,op_const_reg(A_SUB,S_L,0,R_ESP));
  634. exprasmlist^.concat(corr);
  635. if (p^.resulttype<>pdef(voiddef)) and
  636. ret_in_param(p^.resulttype) then
  637. begin
  638. funcretref.symbol:=nil;
  639. {$ifdef test_dest_loc}
  640. if dest_loc_known and (dest_loc_tree=p) and
  641. (dest_loc.loc in [LOC_REFERENCE,LOC_MEM]) then
  642. begin
  643. funcretref:=dest_loc.reference;
  644. if assigned(dest_loc.reference.symbol) then
  645. funcretref.symbol:=stringdup(dest_loc.reference.symbol^);
  646. in_dest_loc:=true;
  647. end
  648. else
  649. {$endif test_dest_loc}
  650. if inlined then
  651. begin
  652. reset_reference(funcretref);
  653. funcretref.offset:=gettempofsizepersistant(p^.procdefinition^.retdef^.size);
  654. funcretref.base:=procinfo.framepointer;
  655. end
  656. else
  657. gettempofsizereference(p^.procdefinition^.retdef^.size,funcretref);
  658. end;
  659. if assigned(p^.left) then
  660. begin
  661. pushedparasize:=0;
  662. { be found elsewhere }
  663. if inlined then
  664. para_offset:=p^.procdefinition^.parast^.call_offset+
  665. p^.procdefinition^.parast^.datasize
  666. else
  667. para_offset:=0;
  668. if assigned(p^.right) then
  669. secondcallparan(p^.left,pprocvardef(p^.right^.resulttype)^.para1,
  670. (p^.procdefinition^.options and poleftright)<>0,inlined,para_offset)
  671. else
  672. secondcallparan(p^.left,p^.procdefinition^.para1,
  673. (p^.procdefinition^.options and poleftright)<>0,inlined,para_offset);
  674. end;
  675. params:=p^.left;
  676. p^.left:=nil;
  677. if inlined then
  678. inlinecode^.retoffset:=gettempofsizepersistant(4);
  679. if ret_in_param(p^.resulttype) then
  680. begin
  681. inc(pushedparasize,4);
  682. if inlined then
  683. begin
  684. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  685. newreference(funcretref),R_EDI)));
  686. r:=new_reference(procinfo.framepointer,inlinecode^.retoffset);
  687. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
  688. R_EDI,r)));
  689. end
  690. else
  691. emitpushreferenceaddr(exprasmlist,funcretref);
  692. end;
  693. { procedure variable ? }
  694. if (p^.right=nil) then
  695. begin
  696. { overloaded operator have no symtable }
  697. { push self }
  698. if assigned(p^.symtable) and
  699. (p^.symtable^.symtabletype=withsymtable) then
  700. begin
  701. { dirty trick to avoid the secondcall below }
  702. p^.methodpointer:=genzeronode(callparan);
  703. p^.methodpointer^.location.loc:=LOC_REGISTER;
  704. p^.methodpointer^.location.register:=R_ESI;
  705. { make a reference }
  706. new(r);
  707. reset_reference(r^);
  708. r^.offset:=p^.symtable^.datasize;
  709. r^.base:=procinfo.framepointer;
  710. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
  711. end;
  712. { push self }
  713. if assigned(p^.symtable) and
  714. ((p^.symtable^.symtabletype=objectsymtable) or
  715. (p^.symtable^.symtabletype=withsymtable)) then
  716. begin
  717. if assigned(p^.methodpointer) then
  718. begin
  719. {
  720. if p^.methodpointer^.resulttype=classrefdef then
  721. begin
  722. two possibilities:
  723. 1. constructor
  724. 2. class method
  725. end
  726. else }
  727. begin
  728. case p^.methodpointer^.treetype of
  729. typen:
  730. begin
  731. { direct call to inherited method }
  732. if (p^.procdefinition^.options and poabstractmethod)<>0 then
  733. begin
  734. Message(cg_e_cant_call_abstract_method);
  735. goto dont_call;
  736. end;
  737. { generate no virtual call }
  738. no_virtual_call:=true;
  739. if (p^.symtableprocentry^.properties and sp_static)<>0 then
  740. begin
  741. { well lets put the VMT address directly into ESI }
  742. { it is kind of dirty but that is the simplest }
  743. { way to accept virtual static functions (PM) }
  744. loadesi:=true;
  745. exprasmlist^.concat(new(pai386,op_csymbol_reg(A_MOV,S_L,
  746. newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0),R_ESI)));
  747. maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
  748. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
  749. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  750. end
  751. else
  752. { this is a member call, so ESI isn't modfied }
  753. loadesi:=false;
  754. if not(is_con_or_destructor and
  755. pobjectdef(p^.methodpointer^.resulttype)^.isclass and
  756. assigned(aktprocsym) and
  757. ((aktprocsym^.definition^.options and
  758. (poconstructor or podestructor))<>0)) then
  759. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  760. { if an inherited con- or destructor should be }
  761. { called in a con- or destructor then a warning }
  762. { will be made }
  763. { con- and destructors need a pointer to the vmt }
  764. if is_con_or_destructor and
  765. not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) and
  766. assigned(aktprocsym) then
  767. begin
  768. if not ((aktprocsym^.definition^.options
  769. and (poconstructor or podestructor))<>0) then
  770. Message(cg_w_member_cd_call_from_method);
  771. end;
  772. if is_con_or_destructor then
  773. push_int(0)
  774. end;
  775. hnewn:
  776. begin
  777. { extended syntax of new }
  778. { ESI must be zero }
  779. exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_ESI,R_ESI)));
  780. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  781. { insert the vmt }
  782. exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
  783. newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
  784. maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
  785. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
  786. extended_new:=true;
  787. end;
  788. hdisposen:
  789. begin
  790. secondpass(p^.methodpointer);
  791. { destructor with extended syntax called from dispose }
  792. { hdisposen always deliver LOC_REFERENCE }
  793. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  794. newreference(p^.methodpointer^.location.reference),R_ESI)));
  795. del_reference(p^.methodpointer^.location.reference);
  796. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  797. exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
  798. newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
  799. maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
  800. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
  801. end;
  802. else
  803. begin
  804. { call to an instance member }
  805. if (p^.symtable^.symtabletype<>withsymtable) then
  806. begin
  807. secondpass(p^.methodpointer);
  808. case p^.methodpointer^.location.loc of
  809. LOC_REGISTER:
  810. begin
  811. ungetregister32(p^.methodpointer^.location.register);
  812. emit_reg_reg(A_MOV,S_L,p^.methodpointer^.location.register,R_ESI);
  813. end;
  814. else
  815. begin
  816. if (p^.methodpointer^.resulttype^.deftype=objectdef) and
  817. pobjectdef(p^.methodpointer^.resulttype)^.isclass then
  818. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  819. newreference(p^.methodpointer^.location.reference),R_ESI)))
  820. else
  821. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
  822. newreference(p^.methodpointer^.location.reference),R_ESI)));
  823. del_reference(p^.methodpointer^.location.reference);
  824. end;
  825. end;
  826. end;
  827. { when calling a class method, we have
  828. to load ESI with the VMT !
  829. But that's wrong, if we call a class method via self
  830. }
  831. if ((p^.procdefinition^.options and poclassmethod)<>0)
  832. and not(p^.methodpointer^.treetype=selfn) then
  833. begin
  834. { class method needs current VMT }
  835. new(r);
  836. reset_reference(r^);
  837. r^.base:=R_ESI;
  838. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
  839. end;
  840. { direct call to class constructor, don't allocate memory }
  841. if is_con_or_destructor and (p^.methodpointer^.resulttype^.deftype=objectdef) and
  842. (pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  843. exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,0)))
  844. else
  845. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  846. if is_con_or_destructor then
  847. begin
  848. { classes don't get a VMT pointer pushed }
  849. if (p^.methodpointer^.resulttype^.deftype=objectdef) and
  850. not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  851. begin
  852. if ((p^.procdefinition^.options and poconstructor)<>0) then
  853. begin
  854. { it's no bad idea, to insert the VMT }
  855. exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
  856. newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,
  857. 0))));
  858. maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
  859. pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
  860. end
  861. { destructors haven't to dispose the instance, if this is }
  862. { a direct call }
  863. else
  864. push_int(0);
  865. end;
  866. end;
  867. end;
  868. end;
  869. end;
  870. end
  871. else
  872. begin
  873. if ((p^.procdefinition^.options and poclassmethod)<>0) and
  874. not(
  875. assigned(aktprocsym) and
  876. ((aktprocsym^.definition^.options and poclassmethod)<>0)
  877. ) then
  878. begin
  879. { class method needs current VMT }
  880. new(r);
  881. reset_reference(r^);
  882. r^.base:=R_ESI;
  883. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
  884. end
  885. else
  886. begin
  887. { member call, ESI isn't modified }
  888. loadesi:=false;
  889. end;
  890. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  891. { but a con- or destructor here would probably almost }
  892. { always be placed wrong }
  893. if is_con_or_destructor then
  894. begin
  895. Message(cg_w_member_cd_call_from_method);
  896. push_int(0);
  897. end;
  898. end;
  899. end;
  900. { push base pointer ?}
  901. if (lexlevel>1) and assigned(pprocdef(p^.procdefinition)^.parast) and
  902. ((p^.procdefinition^.parast^.symtablelevel)>2) then
  903. begin
  904. { if we call a nested function in a method, we must }
  905. { push also SELF! }
  906. { THAT'S NOT TRUE, we have to load ESI via frame pointer }
  907. { access }
  908. {
  909. begin
  910. loadesi:=false;
  911. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
  912. end;
  913. }
  914. if lexlevel=(p^.procdefinition^.parast^.symtablelevel) then
  915. begin
  916. new(r);
  917. reset_reference(r^);
  918. r^.offset:=procinfo.framepointer_offset;
  919. r^.base:=procinfo.framepointer;
  920. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,r)))
  921. end
  922. { this is only true if the difference is one !!
  923. but it cannot be more !! }
  924. else if (lexlevel=p^.procdefinition^.parast^.symtablelevel-1) then
  925. begin
  926. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,procinfo.framepointer)))
  927. end
  928. else if (lexlevel>p^.procdefinition^.parast^.symtablelevel) then
  929. begin
  930. hregister:=getregister32;
  931. new(r);
  932. reset_reference(r^);
  933. r^.offset:=procinfo.framepointer_offset;
  934. r^.base:=procinfo.framepointer;
  935. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,hregister)));
  936. for i:=(p^.procdefinition^.parast^.symtablelevel) to lexlevel-1 do
  937. begin
  938. new(r);
  939. reset_reference(r^);
  940. {we should get the correct frame_pointer_offset at each level
  941. how can we do this !!! }
  942. r^.offset:=procinfo.framepointer_offset;
  943. r^.base:=hregister;
  944. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,hregister)));
  945. end;
  946. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,hregister)));
  947. ungetregister32(hregister);
  948. end
  949. else
  950. internalerror(25000);
  951. end;
  952. { exported methods should be never called direct.
  953. Why? Bp7 Allows it (PFV)
  954. if (p^.procdefinition^.options and poexports)<>0 then
  955. Message(cg_e_dont_call_exported_direct); }
  956. if (not inlined) and ((pushedparasize mod 4)<>0) then
  957. begin
  958. corr^.op1:=pointer(4-(pushedparasize mod 4));
  959. must_pop:=true;
  960. pop_size:=4-(pushedparasize mod 4);
  961. end
  962. else
  963. begin
  964. exprasmlist^.remove(corr);
  965. must_pop:=false;
  966. pop_size:=0;
  967. end;
  968. if ((p^.procdefinition^.options and povirtualmethod)<>0) and
  969. not(no_virtual_call) then
  970. begin
  971. { static functions contain the vmt_address in ESI }
  972. { also class methods }
  973. if assigned(aktprocsym) then
  974. begin
  975. if ((aktprocsym^.properties and sp_static)<>0) or
  976. ((aktprocsym^.definition^.options and poclassmethod)<>0) or
  977. ((p^.procdefinition^.options and postaticmethod)<>0) or
  978. ((p^.procdefinition^.options and poconstructor)<>0) or
  979. { ESI is loaded earlier }
  980. ((p^.procdefinition^.options and poclassmethod)<>0)then
  981. begin
  982. new(r);
  983. reset_reference(r^);
  984. r^.base:=R_ESI;
  985. end
  986. else
  987. begin
  988. new(r);
  989. reset_reference(r^);
  990. r^.base:=R_ESI;
  991. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
  992. new(r);
  993. reset_reference(r^);
  994. r^.base:=R_EDI;
  995. end;
  996. end
  997. else
  998. { aktprocsym should be assigned, also in main program }
  999. internalerror(12345);
  1000. {
  1001. begin
  1002. new(r);
  1003. reset_reference(r^);
  1004. r^.base:=R_ESI;
  1005. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
  1006. new(r);
  1007. reset_reference(r^);
  1008. r^.base:=R_EDI;
  1009. end;
  1010. }
  1011. if p^.procdefinition^.extnumber=-1 then
  1012. internalerror($Da);
  1013. r^.offset:=p^.procdefinition^.extnumber*4+12;
  1014. if (cs_check_range in aktlocalswitches) then
  1015. begin
  1016. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,r^.base)));
  1017. emitcall('CHECK_OBJECT',true);
  1018. end;
  1019. exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,r)));
  1020. end
  1021. else if not inlined then
  1022. emitcall(p^.procdefinition^.mangledname,
  1023. (p^.symtableproc^.symtabletype=unitsymtable) or
  1024. ((p^.symtableproc^.symtabletype=objectsymtable) and
  1025. (pobjectdef(p^.symtableproc^.defowner)^.owner^.symtabletype=unitsymtable)))
  1026. else { inlined proc }
  1027. { inlined code is in inlinecode }
  1028. begin
  1029. secondpass(inlinecode);
  1030. { set poinline again }
  1031. p^.procdefinition^.options:=p^.procdefinition^.options or poinline;
  1032. { free the args }
  1033. ungetpersistanttemp(p^.procdefinition^.parast^.call_offset,
  1034. p^.procdefinition^.parast^.datasize);
  1035. end;
  1036. end
  1037. else
  1038. { now procedure variable case }
  1039. begin
  1040. if (pushedparasize mod 4)<>0 then
  1041. begin
  1042. corr^.op1:=pointer(4-(pushedparasize mod 4));
  1043. must_pop:=true;
  1044. pop_size:=4-(pushedparasize mod 4);
  1045. end
  1046. else
  1047. begin
  1048. exprasmlist^.remove(corr);
  1049. must_pop:=false;
  1050. pop_size:=0;
  1051. end;
  1052. secondpass(p^.right);
  1053. { method pointer ? }
  1054. if (p^.procdefinition^.options and pomethodpointer)<>0 then
  1055. begin
  1056. { method pointer can't be in a register }
  1057. inc(p^.right^.location.reference.offset,4);
  1058. { push self pointer }
  1059. exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,newreference(p^.right^.location.reference))));
  1060. del_reference(p^.right^.location.reference);
  1061. dec(p^.right^.location.reference.offset,4);
  1062. end;
  1063. case p^.right^.location.loc of
  1064. LOC_REGISTER,LOC_CREGISTER:
  1065. begin
  1066. exprasmlist^.concat(new(pai386,op_reg(A_CALL,S_NO,p^.right^.location.register)));
  1067. ungetregister32(p^.right^.location.register);
  1068. end
  1069. else
  1070. exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,newreference(p^.right^.location.reference))));
  1071. del_reference(p^.right^.location.reference);
  1072. end;
  1073. end;
  1074. { this was only for normal functions
  1075. displaced here so we also get
  1076. it to work for procvars PM }
  1077. if (not inlined) and ((p^.procdefinition^.options and poclearstack)<>0) then
  1078. begin
  1079. { consider the alignment with the rest (PM) }
  1080. pushedparasize:=pushedparasize+pop_size;
  1081. must_pop:=false;
  1082. if pushedparasize=4 then
  1083. { better than an add on all processors }
  1084. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)))
  1085. { the pentium has two pipes and pop reg is pairable }
  1086. { but the registers must be different! }
  1087. else if (pushedparasize=8) and
  1088. not(cs_littlesize in aktglobalswitches) and
  1089. (aktoptprocessor=pentium) and
  1090. (procinfo._class=nil) then
  1091. begin
  1092. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
  1093. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_ESI)));
  1094. end
  1095. else exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,pushedparasize,R_ESP)));
  1096. end;
  1097. dont_call:
  1098. pushedparasize:=oldpushedparasize;
  1099. unused:=unusedregisters;
  1100. { handle function results }
  1101. { structured results are easy to handle.... }
  1102. { needed also when result_no_used !! }
  1103. if (p^.resulttype<>pdef(voiddef)) and ret_in_param(p^.resulttype) then
  1104. begin
  1105. p^.location.loc:=LOC_MEM;
  1106. stringdispose(p^.location.reference.symbol);
  1107. p^.location.reference:=funcretref;
  1108. end;
  1109. if (p^.resulttype<>pdef(voiddef)) and p^.return_value_used then
  1110. begin
  1111. { a contructor could be a function with boolean result }
  1112. if (p^.right=nil) and
  1113. ((p^.procdefinition^.options and poconstructor)<>0) and
  1114. { quick'n'dirty check if it is a class or an object }
  1115. (p^.resulttype^.deftype=orddef) then
  1116. begin
  1117. p^.location.loc:=LOC_FLAGS;
  1118. p^.location.resflags:=F_NE;
  1119. if extended_new then
  1120. begin
  1121. {$ifdef test_dest_loc}
  1122. if dest_loc_known and (dest_loc_tree=p) then
  1123. mov_reg_to_dest(p,S_L,R_EAX)
  1124. else
  1125. {$endif test_dest_loc}
  1126. begin
  1127. hregister:=getregister32;
  1128. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1129. p^.location.register:=hregister;
  1130. end;
  1131. end;
  1132. end
  1133. { structed results are easy to handle.... }
  1134. else if ret_in_param(p^.resulttype) then
  1135. begin
  1136. {p^.location.loc:=LOC_MEM;
  1137. stringdispose(p^.location.reference.symbol);
  1138. p^.location.reference:=funcretref;
  1139. already done above (PM) }
  1140. end
  1141. else
  1142. begin
  1143. if (p^.resulttype^.deftype=orddef) then
  1144. begin
  1145. p^.location.loc:=LOC_REGISTER;
  1146. case porddef(p^.resulttype)^.typ of
  1147. s32bit,u32bit,bool32bit :
  1148. begin
  1149. {$ifdef test_dest_loc}
  1150. if dest_loc_known and (dest_loc_tree=p) then
  1151. mov_reg_to_dest(p,S_L,R_EAX)
  1152. else
  1153. {$endif test_dest_loc}
  1154. begin
  1155. hregister:=getregister32;
  1156. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1157. p^.location.register:=hregister;
  1158. end;
  1159. end;
  1160. uchar,u8bit,bool8bit,s8bit :
  1161. begin
  1162. {$ifdef test_dest_loc}
  1163. if dest_loc_known and (dest_loc_tree=p) then
  1164. mov_reg_to_dest(p,S_B,R_AL)
  1165. else
  1166. {$endif test_dest_loc}
  1167. begin
  1168. hregister:=getregister32;
  1169. emit_reg_reg(A_MOV,S_B,R_AL,reg32toreg8(hregister));
  1170. p^.location.register:=reg32toreg8(hregister);
  1171. end;
  1172. end;
  1173. s16bit,u16bit,bool16bit :
  1174. begin
  1175. {$ifdef test_dest_loc}
  1176. if dest_loc_known and (dest_loc_tree=p) then
  1177. mov_reg_to_dest(p,S_W,R_AX)
  1178. else
  1179. {$endif test_dest_loc}
  1180. begin
  1181. hregister:=getregister32;
  1182. emit_reg_reg(A_MOV,S_W,R_AX,reg32toreg16(hregister));
  1183. p^.location.register:=reg32toreg16(hregister);
  1184. end;
  1185. end;
  1186. else internalerror(7);
  1187. end
  1188. end
  1189. else if (p^.resulttype^.deftype=floatdef) then
  1190. case pfloatdef(p^.resulttype)^.typ of
  1191. f32bit : begin
  1192. p^.location.loc:=LOC_REGISTER;
  1193. {$ifdef test_dest_loc}
  1194. if dest_loc_known and (dest_loc_tree=p) then
  1195. mov_reg_to_dest(p,S_L,R_EAX)
  1196. else
  1197. {$endif test_dest_loc}
  1198. begin
  1199. hregister:=getregister32;
  1200. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1201. p^.location.register:=hregister;
  1202. end;
  1203. end;
  1204. else
  1205. p^.location.loc:=LOC_FPU;
  1206. end
  1207. else
  1208. begin
  1209. p^.location.loc:=LOC_REGISTER;
  1210. {$ifdef test_dest_loc}
  1211. if dest_loc_known and (dest_loc_tree=p) then
  1212. mov_reg_to_dest(p,S_L,R_EAX)
  1213. else
  1214. {$endif test_dest_loc}
  1215. begin
  1216. hregister:=getregister32;
  1217. emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
  1218. p^.location.register:=hregister;
  1219. end;
  1220. end;
  1221. end;
  1222. end;
  1223. { perhaps i/o check ? }
  1224. if iolabel<>nil then
  1225. begin
  1226. exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,newcsymbol(lab2str(iolabel),0))));
  1227. { this was wrong, probably an error due to diff3
  1228. emitcall(p^.procdefinition^.mangledname);}
  1229. emitcall('IOCHECK',true);
  1230. end;
  1231. if must_pop then
  1232. exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,pop_size,R_ESP)));
  1233. { restore registers }
  1234. popusedregisters(pushed);
  1235. { at last, restore instance pointer (SELF) }
  1236. if loadesi then
  1237. maybe_loadesi;
  1238. pp:=params;
  1239. while assigned(pp) do
  1240. begin
  1241. if assigned(pp^.left) then
  1242. if (pp^.left^.location.loc=LOC_REFERENCE) or
  1243. (pp^.left^.location.loc=LOC_MEM) then
  1244. ungetiftemp(pp^.left^.location.reference);
  1245. pp:=pp^.right;
  1246. end;
  1247. if inlined then
  1248. ungetpersistanttemp(inlinecode^.retoffset,4);
  1249. disposetree(params);
  1250. { from now on the result can be freed normally }
  1251. if inlined and ret_in_param(p^.resulttype) then
  1252. persistanttemptonormal(funcretref.offset);
  1253. { if return value is not used }
  1254. if (not p^.return_value_used) and (p^.resulttype<>pdef(voiddef)) then
  1255. begin
  1256. if p^.location.loc in [LOC_MEM,LOC_REFERENCE] then
  1257. { release unused temp }
  1258. ungetiftemp(p^.location.reference)
  1259. else if p^.location.loc=LOC_FPU then
  1260. { release FPU stack }
  1261. exprasmlist^.concat(new(pai386,op_none(A_FDECSTP,S_NO)));
  1262. end;
  1263. end;
  1264. { reverts the parameter list }
  1265. var nb_para : integer;
  1266. function reversparameter(p : ptree) : ptree;
  1267. var
  1268. hp1,hp2 : ptree;
  1269. begin
  1270. hp1:=nil;
  1271. nb_para := 0;
  1272. while assigned(p) do
  1273. begin
  1274. { pull out }
  1275. hp2:=p;
  1276. p:=p^.right;
  1277. inc(nb_para);
  1278. { pull in }
  1279. hp2^.right:=hp1;
  1280. hp1:=hp2;
  1281. end;
  1282. reversparameter:=hp1;
  1283. end;
  1284. {*****************************************************************************
  1285. SecondInLine
  1286. *****************************************************************************}
  1287. procedure secondinline(var p : ptree);
  1288. const
  1289. {$ifdef OLDINC}
  1290. decisize:array[in_inc_byte..in_dec_dword] of Topsize=
  1291. (S_B,S_W,S_L,S_B,S_W,S_L);
  1292. in2instr:array[in_inc_byte..in_dec_dword] of Tasmop=
  1293. (A_INC,A_INC,A_INC,A_DEC,A_DEC,A_DEC);
  1294. ad2instr:array[in_inc_byte..in_dec_dword] of Tasmop=
  1295. (A_ADD,A_ADD,A_ADD,A_SUB,A_SUB,A_SUB);
  1296. {$endif OLDINC}
  1297. { tfloattype = (f32bit,s32real,s64real,s80real,s64bit); }
  1298. float_name: array[tfloattype] of string[8]=
  1299. ('FIXED','SINGLE','REAL','EXTENDED','COMP','FIXED16');
  1300. incdecop:array[in_inc_x..in_dec_x] of tasmop=(A_INC,A_DEC);
  1301. addsubop:array[in_inc_x..in_dec_x] of tasmop=(A_ADD,A_SUB);
  1302. var
  1303. aktfile : treference;
  1304. ft : tfiletype;
  1305. opsize : topsize;
  1306. asmop : tasmop;
  1307. pushed : tpushed;
  1308. {inc/dec}
  1309. addconstant : boolean;
  1310. addvalue : longint;
  1311. procedure handlereadwrite(doread,doln : boolean);
  1312. { produces code for READ(LN) and WRITE(LN) }
  1313. procedure loadstream;
  1314. const
  1315. io:array[0..1] of string[7]=('_OUTPUT','_INPUT');
  1316. var
  1317. r : preference;
  1318. begin
  1319. new(r);
  1320. reset_reference(r^);
  1321. r^.symbol:=stringdup('U_'+upper(target_info.system_unit)+io[byte(doread)]);
  1322. concat_external(r^.symbol^,EXT_NEAR);
  1323. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,r,R_EDI)))
  1324. end;
  1325. var
  1326. node,hp : ptree;
  1327. typedtyp,
  1328. pararesult : pdef;
  1329. has_length : boolean;
  1330. dummycoll : tdefcoll;
  1331. iolabel : plabel;
  1332. npara : longint;
  1333. begin
  1334. { I/O check }
  1335. if cs_check_io in aktlocalswitches then
  1336. begin
  1337. getlabel(iolabel);
  1338. emitl(A_LABEL,iolabel);
  1339. end
  1340. else
  1341. iolabel:=nil;
  1342. { for write of real with the length specified }
  1343. has_length:=false;
  1344. hp:=nil;
  1345. { reserve temporary pointer to data variable }
  1346. aktfile.symbol:=nil;
  1347. gettempofsizereference(4,aktfile);
  1348. { first state text data }
  1349. ft:=ft_text;
  1350. { and state a parameter ? }
  1351. if p^.left=nil then
  1352. begin
  1353. { the following instructions are for "writeln;" }
  1354. loadstream;
  1355. { save @aktfile in temporary variable }
  1356. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,newreference(aktfile))));
  1357. end
  1358. else
  1359. begin
  1360. { revers paramters }
  1361. node:=reversparameter(p^.left);
  1362. p^.left := node;
  1363. npara := nb_para;
  1364. { calculate data variable }
  1365. { is first parameter a file type ? }
  1366. if node^.left^.resulttype^.deftype=filedef then
  1367. begin
  1368. ft:=pfiledef(node^.left^.resulttype)^.filetype;
  1369. if ft=ft_typed then
  1370. typedtyp:=pfiledef(node^.left^.resulttype)^.typed_as;
  1371. secondpass(node^.left);
  1372. if codegenerror then
  1373. exit;
  1374. { save reference in temporary variables }
  1375. if node^.left^.location.loc<>LOC_REFERENCE then
  1376. begin
  1377. Message(cg_e_illegal_expression);
  1378. exit;
  1379. end;
  1380. exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(node^.left^.location.reference),R_EDI)));
  1381. { skip to the next parameter }
  1382. node:=node^.right;
  1383. end
  1384. else
  1385. begin
  1386. { load stdin/stdout stream }
  1387. loadstream;
  1388. end;
  1389. { save @aktfile in temporary variable }
  1390. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,newreference(aktfile))));
  1391. if doread then
  1392. { parameter by READ gives call by reference }
  1393. dummycoll.paratyp:=vs_var
  1394. { an WRITE Call by "Const" }
  1395. else
  1396. dummycoll.paratyp:=vs_const;
  1397. { because of secondcallparan, which otherwise attaches }
  1398. if ft=ft_typed then
  1399. { this is to avoid copy of simple const parameters }
  1400. dummycoll.data:=new(pformaldef,init)
  1401. else
  1402. { I think, this isn't a good solution (FK) }
  1403. dummycoll.data:=nil;
  1404. while assigned(node) do
  1405. begin
  1406. pushusedregisters(pushed,$ff);
  1407. hp:=node;
  1408. node:=node^.right;
  1409. hp^.right:=nil;
  1410. if hp^.is_colon_para then
  1411. Message(parser_e_illegal_colon_qualifier);
  1412. if ft=ft_typed then
  1413. never_copy_const_param:=true;
  1414. secondcallparan(hp,@dummycoll,false,false,0);
  1415. if ft=ft_typed then
  1416. never_copy_const_param:=false;
  1417. hp^.right:=node;
  1418. if codegenerror then
  1419. exit;
  1420. emit_push_mem(aktfile);
  1421. if (ft=ft_typed) then
  1422. begin
  1423. { OK let's try this }
  1424. { first we must only allow the right type }
  1425. { we have to call blockread or blockwrite }
  1426. { but the real problem is that }
  1427. { reset and rewrite should have set }
  1428. { the type size }
  1429. { as recordsize for that file !!!! }
  1430. { how can we make that }
  1431. { I think that is only possible by adding }
  1432. { reset and rewrite to the inline list a call }
  1433. { allways read only one record by element }
  1434. push_int(typedtyp^.size);
  1435. if doread then
  1436. emitcall('TYPED_READ',true)
  1437. else
  1438. emitcall('TYPED_WRITE',true);
  1439. end
  1440. else
  1441. begin
  1442. { save current position }
  1443. pararesult:=hp^.left^.resulttype;
  1444. { handle possible field width }
  1445. { of course only for write(ln) }
  1446. if not doread then
  1447. begin
  1448. { handle total width parameter }
  1449. if assigned(node) and node^.is_colon_para then
  1450. begin
  1451. hp:=node;
  1452. node:=node^.right;
  1453. hp^.right:=nil;
  1454. secondcallparan(hp,@dummycoll,false,false,0);
  1455. hp^.right:=node;
  1456. if codegenerror then
  1457. exit;
  1458. has_length:=true;
  1459. end
  1460. else
  1461. if pararesult^.deftype<>floatdef then
  1462. push_int(0)
  1463. else
  1464. push_int(-32767);
  1465. { a second colon para for a float ? }
  1466. if assigned(node) and node^.is_colon_para then
  1467. begin
  1468. hp:=node;
  1469. node:=node^.right;
  1470. hp^.right:=nil;
  1471. secondcallparan(hp,@dummycoll,false,false,0);
  1472. hp^.right:=node;
  1473. if pararesult^.deftype<>floatdef then
  1474. Message(parser_e_illegal_colon_qualifier);
  1475. if codegenerror then
  1476. exit;
  1477. end
  1478. else
  1479. begin
  1480. if pararesult^.deftype=floatdef then
  1481. push_int(-1);
  1482. end
  1483. end;
  1484. case pararesult^.deftype of
  1485. stringdef : begin
  1486. if doread then
  1487. begin
  1488. { push maximum string length }
  1489. push_int(pstringdef(pararesult)^.len);
  1490. case pstringdef(pararesult)^.string_typ of
  1491. st_shortstring:
  1492. emitcall ('READ_TEXT_STRING',true);
  1493. st_ansistring:
  1494. emitcall ('READ_TEXT_ANSISTRING',true);
  1495. st_longstring:
  1496. emitcall ('READ_TEXT_LONGSTRING',true);
  1497. st_widestring:
  1498. emitcall ('READ_TEXT_ANSISTRING',true);
  1499. end
  1500. end
  1501. else
  1502. Case pstringdef(Pararesult)^.string_typ of
  1503. st_shortstring:
  1504. emitcall ('WRITE_TEXT_STRING',true);
  1505. st_ansistring:
  1506. emitcall ('WRITE_TEXT_ANSISTRING',true);
  1507. st_longstring:
  1508. emitcall ('WRITE_TEXT_LONGSTRING',true);
  1509. st_widestring:
  1510. emitcall ('WRITE_TEXT_ANSISTRING',true);
  1511. end;
  1512. end;
  1513. pointerdef : begin
  1514. if is_equal(ppointerdef(pararesult)^.definition,cchardef) then
  1515. begin
  1516. if doread then
  1517. emitcall('READ_TEXT_PCHAR_AS_POINTER',true)
  1518. else
  1519. emitcall('WRITE_TEXT_PCHAR_AS_POINTER',true);
  1520. end
  1521. else
  1522. Message(parser_e_illegal_parameter_list);
  1523. end;
  1524. arraydef : begin
  1525. if (parraydef(pararesult)^.lowrange=0) and
  1526. is_equal(parraydef(pararesult)^.definition,cchardef) then
  1527. begin
  1528. if doread then
  1529. emitcall('READ_TEXT_PCHAR_AS_ARRAY',true)
  1530. else
  1531. emitcall('WRITE_TEXT_PCHAR_AS_ARRAY',true);
  1532. end
  1533. else
  1534. Message(parser_e_illegal_parameter_list);
  1535. end;
  1536. floatdef : begin
  1537. if doread then
  1538. emitcall('READ_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true)
  1539. else
  1540. emitcall('WRITE_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true);
  1541. end;
  1542. orddef : begin
  1543. case porddef(pararesult)^.typ of
  1544. u8bit : if doread then
  1545. emitcall('READ_TEXT_BYTE',true);
  1546. s8bit : if doread then
  1547. emitcall('READ_TEXT_SHORTINT',true);
  1548. u16bit : if doread then
  1549. emitcall('READ_TEXT_WORD',true);
  1550. s16bit : if doread then
  1551. emitcall('READ_TEXT_INTEGER',true);
  1552. s32bit : if doread then
  1553. emitcall('READ_TEXT_LONGINT',true)
  1554. else
  1555. emitcall('WRITE_TEXT_LONGINT',true);
  1556. u32bit : if doread then
  1557. emitcall('READ_TEXT_CARDINAL',true)
  1558. else
  1559. emitcall('WRITE_TEXT_CARDINAL',true);
  1560. uchar : if doread then
  1561. emitcall('READ_TEXT_CHAR',true)
  1562. else
  1563. emitcall('WRITE_TEXT_CHAR',true);
  1564. bool8bit,
  1565. bool16bit,
  1566. bool32bit : if doread then
  1567. { emitcall('READ_TEXT_BOOLEAN',true) }
  1568. Message(parser_e_illegal_parameter_list)
  1569. else
  1570. emitcall('WRITE_TEXT_BOOLEAN',true);
  1571. else
  1572. Message(parser_e_illegal_parameter_list);
  1573. end;
  1574. end;
  1575. else
  1576. Message(parser_e_illegal_parameter_list);
  1577. end;
  1578. end;
  1579. { load ESI in methods again }
  1580. popusedregisters(pushed);
  1581. maybe_loadesi;
  1582. end;
  1583. end;
  1584. { Insert end of writing for textfiles }
  1585. if ft=ft_text then
  1586. begin
  1587. pushusedregisters(pushed,$ff);
  1588. emit_push_mem(aktfile);
  1589. if doread then
  1590. begin
  1591. if doln then
  1592. emitcall('READLN_END',true)
  1593. else
  1594. emitcall('READ_END',true);
  1595. end
  1596. else
  1597. begin
  1598. if doln then
  1599. emitcall('WRITELN_END',true)
  1600. else
  1601. emitcall('WRITE_END',true);
  1602. end;
  1603. popusedregisters(pushed);
  1604. maybe_loadesi;
  1605. end;
  1606. { Insert IOCheck if set }
  1607. if assigned(iolabel) then
  1608. begin
  1609. { registers are saved in the procedure }
  1610. exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,newcsymbol(lab2str(iolabel),0))));
  1611. emitcall('IOCHECK',true);
  1612. end;
  1613. { Freeup all used temps }
  1614. ungetiftemp(aktfile);
  1615. if assigned(p^.left) then
  1616. begin
  1617. p^.left:=reversparameter(p^.left);
  1618. if npara<>nb_para then
  1619. Message(cg_f_internal_error_in_secondinline);
  1620. hp:=p^.left;
  1621. while assigned(hp) do
  1622. begin
  1623. if assigned(hp^.left) then
  1624. if (hp^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
  1625. ungetiftemp(hp^.left^.location.reference);
  1626. hp:=hp^.right;
  1627. end;
  1628. end;
  1629. end;
  1630. procedure handle_str;
  1631. var
  1632. hp,node : ptree;
  1633. dummycoll : tdefcoll;
  1634. is_real,has_length : boolean;
  1635. begin
  1636. pushusedregisters(pushed,$ff);
  1637. node:=p^.left;
  1638. is_real:=false;
  1639. has_length:=false;
  1640. while assigned(node^.right) do node:=node^.right;
  1641. { if a real parameter somewhere then call REALSTR }
  1642. if (node^.left^.resulttype^.deftype=floatdef) then
  1643. is_real:=true;
  1644. node:=p^.left;
  1645. { we have at least two args }
  1646. { with at max 2 colon_para in between }
  1647. { first arg longint or float }
  1648. hp:=node;
  1649. node:=node^.right;
  1650. hp^.right:=nil;
  1651. dummycoll.data:=hp^.resulttype;
  1652. { string arg }
  1653. dummycoll.paratyp:=vs_var;
  1654. secondcallparan(hp,@dummycoll,false
  1655. ,false,0
  1656. );
  1657. if codegenerror then
  1658. exit;
  1659. dummycoll.paratyp:=vs_const;
  1660. { second arg }
  1661. hp:=node;
  1662. node:=node^.right;
  1663. hp^.right:=nil;
  1664. { frac para }
  1665. if hp^.is_colon_para and assigned(node) and
  1666. node^.is_colon_para then
  1667. begin
  1668. dummycoll.data:=hp^.resulttype;
  1669. secondcallparan(hp,@dummycoll,false
  1670. ,false,0
  1671. );
  1672. if codegenerror then
  1673. exit;
  1674. hp:=node;
  1675. node:=node^.right;
  1676. hp^.right:=nil;
  1677. has_length:=true;
  1678. end
  1679. else
  1680. if is_real then
  1681. push_int(-1);
  1682. { third arg, length only if is_real }
  1683. if hp^.is_colon_para then
  1684. begin
  1685. dummycoll.data:=hp^.resulttype;
  1686. secondcallparan(hp,@dummycoll,false
  1687. ,false,0
  1688. );
  1689. if codegenerror then
  1690. exit;
  1691. hp:=node;
  1692. node:=node^.right;
  1693. hp^.right:=nil;
  1694. end
  1695. else
  1696. if is_real then
  1697. push_int(-32767)
  1698. else
  1699. push_int(-1);
  1700. { last arg longint or real }
  1701. secondcallparan(hp,@dummycoll,false
  1702. ,false,0
  1703. );
  1704. if codegenerror then
  1705. exit;
  1706. if is_real then
  1707. emitcall('STR_'+float_name[pfloatdef(hp^.resulttype)^.typ],true)
  1708. else if porddef(hp^.resulttype)^.typ=u32bit then
  1709. emitcall('STR_CARDINAL',true)
  1710. else
  1711. emitcall('STR_LONGINT',true);
  1712. popusedregisters(pushed);
  1713. end;
  1714. var
  1715. r : preference;
  1716. l : longint;
  1717. ispushed : boolean;
  1718. hregister : tregister;
  1719. otlabel,oflabel,filenamestring : plabel;
  1720. begin
  1721. case p^.inlinenumber of
  1722. in_assert_x:
  1723. begin
  1724. otlabel:=truelabel;
  1725. oflabel:=falselabel;
  1726. getlabel(truelabel);
  1727. getlabel(falselabel);
  1728. getlabel(filenamestring);
  1729. secondpass(p^.left);
  1730. if codegenerror then
  1731. exit;
  1732. if cs_do_assertion in aktlocalswitches then
  1733. begin
  1734. maketojumpbool(p^.left);
  1735. emitl(A_LABEL,falselabel);
  1736. exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,
  1737. p^.fileinfo.line)));
  1738. { generate string }
  1739. { push string
  1740. exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,
  1741. p^.fileinfo.line)));
  1742. }
  1743. emitcall('FPC_DO_ASSERT',true);
  1744. emitl(A_LABEL,truelabel);
  1745. end;
  1746. truelabel:=otlabel;
  1747. falselabel:=oflabel;
  1748. end;
  1749. in_lo_word,
  1750. in_hi_word :
  1751. begin
  1752. secondpass(p^.left);
  1753. p^.location.loc:=LOC_REGISTER;
  1754. if p^.left^.location.loc<>LOC_REGISTER then
  1755. begin
  1756. if p^.left^.location.loc=LOC_CREGISTER then
  1757. begin
  1758. p^.location.register:=reg32toreg16(getregister32);
  1759. emit_reg_reg(A_MOV,S_W,p^.left^.location.register,
  1760. p^.location.register);
  1761. end
  1762. else
  1763. begin
  1764. del_reference(p^.left^.location.reference);
  1765. p^.location.register:=reg32toreg16(getregister32);
  1766. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_W,newreference(p^.left^.location.reference),
  1767. p^.location.register)));
  1768. end;
  1769. end
  1770. else p^.location.register:=p^.left^.location.register;
  1771. if p^.inlinenumber=in_hi_word then
  1772. exprasmlist^.concat(new(pai386,op_const_reg(A_SHR,S_W,8,p^.location.register)));
  1773. p^.location.register:=reg16toreg8(p^.location.register);
  1774. end;
  1775. in_high_x :
  1776. begin
  1777. if is_open_array(p^.left^.resulttype) then
  1778. begin
  1779. secondpass(p^.left);
  1780. del_reference(p^.left^.location.reference);
  1781. p^.location.register:=getregister32;
  1782. new(r);
  1783. reset_reference(r^);
  1784. r^.base:=highframepointer;
  1785. r^.offset:=highoffset+4;
  1786. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  1787. r,p^.location.register)));
  1788. end
  1789. end;
  1790. in_sizeof_x,
  1791. in_typeof_x :
  1792. begin
  1793. { for both cases load vmt }
  1794. if p^.left^.treetype=typen then
  1795. begin
  1796. p^.location.register:=getregister32;
  1797. exprasmlist^.concat(new(pai386,op_csymbol_reg(A_MOV,
  1798. S_L,newcsymbol(pobjectdef(p^.left^.resulttype)^.vmt_mangledname,0),
  1799. p^.location.register)));
  1800. end
  1801. else
  1802. begin
  1803. secondpass(p^.left);
  1804. del_reference(p^.left^.location.reference);
  1805. p^.location.loc:=LOC_REGISTER;
  1806. p^.location.register:=getregister32;
  1807. { load VMT pointer }
  1808. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  1809. newreference(p^.left^.location.reference),
  1810. p^.location.register)));
  1811. end;
  1812. { in sizeof load size }
  1813. if p^.inlinenumber=in_sizeof_x then
  1814. begin
  1815. new(r);
  1816. reset_reference(r^);
  1817. r^.base:=p^.location.register;
  1818. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,
  1819. p^.location.register)));
  1820. end;
  1821. end;
  1822. in_lo_long,
  1823. in_hi_long :
  1824. begin
  1825. secondpass(p^.left);
  1826. p^.location.loc:=LOC_REGISTER;
  1827. if p^.left^.location.loc<>LOC_REGISTER then
  1828. begin
  1829. if p^.left^.location.loc=LOC_CREGISTER then
  1830. begin
  1831. p^.location.register:=getregister32;
  1832. emit_reg_reg(A_MOV,S_L,p^.left^.location.register,
  1833. p^.location.register);
  1834. end
  1835. else
  1836. begin
  1837. del_reference(p^.left^.location.reference);
  1838. p^.location.register:=getregister32;
  1839. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
  1840. p^.location.register)));
  1841. end;
  1842. end
  1843. else p^.location.register:=p^.left^.location.register;
  1844. if p^.inlinenumber=in_hi_long then
  1845. exprasmlist^.concat(new(pai386,op_const_reg(A_SHR,S_L,16,p^.location.register)));
  1846. p^.location.register:=reg32toreg16(p^.location.register);
  1847. end;
  1848. {***CHARBUG}
  1849. {We can now comment them out, as they are handled as typecast.
  1850. Saves an incredible amount of 8 bytes code.
  1851. I'am not lucky about this, because it's _not_ a type cast (FK) }
  1852. { in_ord_char,
  1853. in_chr_byte,}
  1854. {***}
  1855. in_length_string :
  1856. begin
  1857. secondpass(p^.left);
  1858. set_location(p^.location,p^.left^.location);
  1859. { length in ansi strings is at offset -8 }
  1860. {$ifdef UseAnsiString}
  1861. if is_ansistring(p^.left^.resulttype) then
  1862. dec(p^.location.reference.offset,8);
  1863. {$endif UseAnsiString}
  1864. end;
  1865. in_pred_x,
  1866. in_succ_x:
  1867. begin
  1868. secondpass(p^.left);
  1869. if p^.inlinenumber=in_pred_x then
  1870. asmop:=A_DEC
  1871. else
  1872. asmop:=A_INC;
  1873. case p^.resulttype^.size of
  1874. 4 : opsize:=S_L;
  1875. 2 : opsize:=S_W;
  1876. 1 : opsize:=S_B;
  1877. else
  1878. internalerror(10080);
  1879. end;
  1880. p^.location.loc:=LOC_REGISTER;
  1881. if p^.left^.location.loc<>LOC_REGISTER then
  1882. begin
  1883. p^.location.register:=getregister32;
  1884. if (p^.resulttype^.size=2) then
  1885. p^.location.register:=reg32toreg16(p^.location.register);
  1886. if (p^.resulttype^.size=1) then
  1887. p^.location.register:=reg32toreg8(p^.location.register);
  1888. if p^.left^.location.loc=LOC_CREGISTER then
  1889. emit_reg_reg(A_MOV,opsize,p^.left^.location.register,
  1890. p^.location.register)
  1891. else
  1892. if p^.left^.location.loc=LOC_FLAGS then
  1893. exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.left^.location.resflags],S_B,
  1894. p^.location.register)))
  1895. else
  1896. begin
  1897. del_reference(p^.left^.location.reference);
  1898. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,newreference(p^.left^.location.reference),
  1899. p^.location.register)));
  1900. end;
  1901. end
  1902. else p^.location.register:=p^.left^.location.register;
  1903. exprasmlist^.concat(new(pai386,op_reg(asmop,opsize,
  1904. p^.location.register)))
  1905. { here we should insert bounds check ? }
  1906. { and direct call to bounds will crash the program }
  1907. { if we are at the limit }
  1908. { we could also simply say that pred(first)=first and succ(last)=last }
  1909. { could this be usefull I don't think so (PM)
  1910. emitoverflowcheck;}
  1911. end;
  1912. in_dec_x,
  1913. in_inc_x :
  1914. begin
  1915. { set defaults }
  1916. addvalue:=1;
  1917. addconstant:=true;
  1918. { load first parameter, must be a reference }
  1919. secondpass(p^.left^.left);
  1920. case p^.left^.left^.resulttype^.deftype of
  1921. orddef,
  1922. enumdef : begin
  1923. case p^.left^.left^.resulttype^.size of
  1924. 1 : opsize:=S_B;
  1925. 2 : opsize:=S_W;
  1926. 4 : opsize:=S_L;
  1927. end;
  1928. end;
  1929. pointerdef : begin
  1930. opsize:=S_L;
  1931. addvalue:=ppointerdef(p^.left^.left^.resulttype)^.definition^.savesize;
  1932. end;
  1933. else
  1934. internalerror(10081);
  1935. end;
  1936. { second argument specified?, must be a s32bit in register }
  1937. if assigned(p^.left^.right) then
  1938. begin
  1939. secondpass(p^.left^.right^.left);
  1940. { when constant, just multiply the addvalue }
  1941. if is_constintnode(p^.left^.right^.left) then
  1942. addvalue:=addvalue*get_ordinal_value(p^.left^.right^.left)
  1943. else
  1944. begin
  1945. case p^.left^.right^.left^.location.loc of
  1946. LOC_REGISTER,
  1947. LOC_CREGISTER : hregister:=p^.left^.right^.left^.location.register;
  1948. LOC_MEM,
  1949. LOC_REFERENCE : begin
  1950. hregister:=getregister32;
  1951. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  1952. newreference(p^.left^.right^.left^.location.reference),hregister)));
  1953. end;
  1954. else
  1955. internalerror(10082);
  1956. end;
  1957. { insert multiply with addvalue if its >1 }
  1958. if addvalue>1 then
  1959. exprasmlist^.concat(new(pai386,op_const_reg(A_IMUL,opsize,
  1960. addvalue,hregister)));
  1961. addconstant:=false;
  1962. end;
  1963. end;
  1964. { write the add instruction }
  1965. if addconstant then
  1966. begin
  1967. if (addvalue=1) and not(cs_check_overflow in aktlocalswitches) then
  1968. exprasmlist^.concat(new(pai386,op_ref(incdecop[p^.inlinenumber],opsize,
  1969. newreference(p^.left^.left^.location.reference))))
  1970. else
  1971. exprasmlist^.concat(new(pai386,op_const_ref(addsubop[p^.inlinenumber],opsize,
  1972. addvalue,newreference(p^.left^.left^.location.reference))));
  1973. end
  1974. else
  1975. begin
  1976. exprasmlist^.concat(new(pai386,op_reg_ref(addsubop[p^.inlinenumber],opsize,
  1977. hregister,newreference(p^.left^.left^.location.reference))));
  1978. ungetregister32(hregister);
  1979. end;
  1980. emitoverflowcheck(p^.left^.left);
  1981. end;
  1982. {$ifdef OLDINC}
  1983. in_inc_byte..in_dec_dword:
  1984. begin
  1985. secondpass(p^.left);
  1986. if cs_check_overflow in aktswitches then
  1987. begin
  1988. { SINCE THE CARRY FLAG IS NEVER SET BY DEC/INC, we must use }
  1989. { ADD and SUB to check for overflow for unsigned operations. }
  1990. exprasmlist^.concat(new(pai386,op_const_ref(ad2instr[p^.inlinenumber],
  1991. in2size[p^.inlinenumber],1,newreference(p^.left^.location.reference))));
  1992. emitoverflowcheck(p^.left);
  1993. end
  1994. else
  1995. exprasmlist^.concat(new(pai386,op_ref(in2instr[p^.inlinenumber],
  1996. in2size[p^.inlinenumber],newreference(p^.left^.location.reference))));
  1997. end;
  1998. {$endif OLDINC}
  1999. in_assigned_x :
  2000. begin
  2001. secondpass(p^.left^.left);
  2002. p^.location.loc:=LOC_FLAGS;
  2003. if (p^.left^.left^.location.loc=LOC_REGISTER) or
  2004. (p^.left^.left^.location.loc=LOC_CREGISTER) then
  2005. begin
  2006. exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_L,
  2007. p^.left^.left^.location.register,
  2008. p^.left^.left^.location.register)));
  2009. ungetregister32(p^.left^.left^.location.register);
  2010. end
  2011. else
  2012. begin
  2013. exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_L,0,
  2014. newreference(p^.left^.left^.location.reference))));
  2015. del_reference(p^.left^.left^.location.reference);
  2016. end;
  2017. p^.location.resflags:=F_NE;
  2018. end;
  2019. in_reset_typedfile,in_rewrite_typedfile :
  2020. begin
  2021. pushusedregisters(pushed,$ff);
  2022. exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,pfiledef(p^.left^.resulttype)^.typed_as^.size)));
  2023. secondload(p^.left);
  2024. emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
  2025. if p^.inlinenumber=in_reset_typedfile then
  2026. emitcall('RESET_TYPED',true)
  2027. else
  2028. emitcall('REWRITE_TYPED',true);
  2029. popusedregisters(pushed);
  2030. end;
  2031. in_write_x :
  2032. handlereadwrite(false,false);
  2033. in_writeln_x :
  2034. handlereadwrite(false,true);
  2035. in_read_x :
  2036. handlereadwrite(true,false);
  2037. in_readln_x :
  2038. handlereadwrite(true,true);
  2039. in_str_x_string :
  2040. begin
  2041. handle_str;
  2042. maybe_loadesi;
  2043. end;
  2044. in_include_x_y,
  2045. in_exclude_x_y:
  2046. begin
  2047. secondpass(p^.left^.left);
  2048. if p^.left^.right^.left^.treetype=ordconstn then
  2049. begin
  2050. { calculate bit position }
  2051. l:=1 shl (p^.left^.right^.left^.value mod 32);
  2052. { determine operator }
  2053. if p^.inlinenumber=in_include_x_y then
  2054. asmop:=A_OR
  2055. else
  2056. begin
  2057. asmop:=A_AND;
  2058. l:=not(l);
  2059. end;
  2060. if (p^.left^.left^.location.loc=LOC_REFERENCE) then
  2061. begin
  2062. inc(p^.left^.left^.location.reference.offset,(p^.left^.right^.left^.value div 32)*4);
  2063. exprasmlist^.concat(new(pai386,op_const_ref(asmop,S_L,
  2064. l,newreference(p^.left^.left^.location.reference))));
  2065. del_reference(p^.left^.left^.location.reference);
  2066. end
  2067. else
  2068. { LOC_CREGISTER }
  2069. exprasmlist^.concat(new(pai386,op_const_reg(asmop,S_L,
  2070. l,p^.left^.left^.location.register)));
  2071. end
  2072. else
  2073. begin
  2074. { generate code for the element to set }
  2075. ispushed:=maybe_push(p^.left^.right^.left^.registers32,p^.left^.left);
  2076. secondpass(p^.left^.right^.left);
  2077. if ispushed then
  2078. restore(p^.left^.left);
  2079. { determine asm operator }
  2080. if p^.inlinenumber=in_include_x_y then
  2081. asmop:=A_BTS
  2082. else
  2083. asmop:=A_BTR;
  2084. if psetdef(p^.left^.resulttype)^.settype=smallset then
  2085. begin
  2086. if p^.left^.right^.left^.location.loc in
  2087. [LOC_CREGISTER,LOC_REGISTER] then
  2088. hregister:=p^.left^.right^.left^.location.register
  2089. else
  2090. begin
  2091. hregister:=R_EDI;
  2092. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
  2093. newreference(p^.left^.right^.left^.location.reference),
  2094. R_EDI)));
  2095. end;
  2096. if (p^.left^.left^.location.loc=LOC_REFERENCE) then
  2097. exprasmlist^.concat(new(pai386,op_reg_ref(asmop,S_L,R_EDI,
  2098. newreference(p^.left^.right^.left^.location.reference))))
  2099. else
  2100. exprasmlist^.concat(new(pai386,op_reg_reg(asmop,S_L,R_EDI,
  2101. p^.left^.right^.left^.location.register)));
  2102. end
  2103. else
  2104. begin
  2105. end;
  2106. end;
  2107. end;
  2108. else internalerror(9);
  2109. end;
  2110. end;
  2111. {*****************************************************************************
  2112. SecondProcInlineN
  2113. *****************************************************************************}
  2114. { implementation not complete yet }
  2115. var
  2116. addr_correction : longint;
  2117. procedure correct_address(p : psym);{$ifndef FPC}far;{$endif}
  2118. begin
  2119. if p^.typ=varsym then
  2120. begin
  2121. inc(pvarsym(p)^.address,addr_correction);
  2122. {$ifdef extdebug}
  2123. Comment(V_debug,pvarsym(p)^.name+' is at offset -'
  2124. +tostr(pvarsym(p)^.address));
  2125. exprasmlist^.concat(new(pai_asm_comment,init(
  2126. strpnew(pvarsym(p)^.name+' is at offset -'
  2127. +tostr(pvarsym(p)^.address)))));
  2128. {$endif extdebug}
  2129. end;
  2130. end;
  2131. procedure secondprocinline(var p : ptree);
  2132. var st : psymtable;
  2133. oldprocsym : pprocsym;
  2134. para_size : longint;
  2135. oldprocinfo : tprocinfo;
  2136. { just dummies for genentrycode }
  2137. nostackframe,make_global : boolean;
  2138. proc_names : tstringcontainer;
  2139. inlineentrycode,inlineexitcode : paasmoutput;
  2140. oldexitlabel,oldexit2label,oldquickexitlabel:Plabel;
  2141. begin
  2142. oldexitlabel:=aktexitlabel;
  2143. oldexit2label:=aktexit2label;
  2144. oldquickexitlabel:=quickexitlabel;
  2145. getlabel(aktexitlabel);
  2146. getlabel(aktexit2label);
  2147. oldprocsym:=aktprocsym;
  2148. oldprocinfo:=procinfo;
  2149. { set the return value }
  2150. procinfo.retdef:=p^.inlineprocdef^.retdef;
  2151. procinfo.retoffset:=p^.retoffset;
  2152. { arg space has been filled by the parent secondcall }
  2153. st:=p^.inlineprocdef^.localst;
  2154. { set it to the same lexical level }
  2155. st^.symtablelevel:=
  2156. oldprocsym^.definition^.localst^.symtablelevel;
  2157. if st^.datasize>0 then
  2158. st^.call_offset:=gettempofsizepersistant(st^.datasize);
  2159. {$ifdef extdebug}
  2160. Comment(V_debug,'local symtable is at offset '
  2161. +tostr(st^.call_offset));
  2162. exprasmlist^.concat(new(pai_asm_comment,init(
  2163. strpnew('local symtable is at offset '
  2164. +tostr(st^.call_offset)))));
  2165. {$endif extdebug}
  2166. addr_correction:=-st^.call_offset-st^.datasize;
  2167. st^.foreach(correct_address);
  2168. {$ifdef extdebug}
  2169. exprasmlist^.concat(new(pai_asm_comment,init('Start of inlined proc')));
  2170. {$endif extdebug}
  2171. { takes care of local data initialization }
  2172. inlineentrycode:=new(paasmoutput,init);
  2173. inlineexitcode:=new(paasmoutput,init);
  2174. proc_names.init;
  2175. para_size:=p^.para_size;
  2176. make_global:=false; { to avoid warning }
  2177. genentrycode(inlineentrycode,proc_names,make_global,0,para_size,nostackframe,true);
  2178. exprasmlist^.concatlist(inlineentrycode);
  2179. secondpass(p^.left);
  2180. genexitcode(inlineexitcode,0,false,true);
  2181. exprasmlist^.concatlist(inlineexitcode);
  2182. {$ifdef extdebug}
  2183. exprasmlist^.concat(new(pai_asm_comment,init('End of inlined proc')));
  2184. {$endif extdebug}
  2185. {we can free the local data now }
  2186. if st^.datasize>0 then
  2187. ungetpersistanttemp(st^.call_offset,st^.datasize);
  2188. { set the real address again }
  2189. addr_correction:=-addr_correction;
  2190. st^.foreach(correct_address);
  2191. aktprocsym:=oldprocsym;
  2192. aktexitlabel:=oldexitlabel;
  2193. aktexit2label:=oldexit2label;
  2194. quickexitlabel:=oldquickexitlabel;
  2195. procinfo:=oldprocinfo;
  2196. end;
  2197. end.
  2198. {
  2199. $Log$
  2200. Revision 1.13 1998-08-10 14:49:45 peter
  2201. + localswitches, moduleswitches, globalswitches splitting
  2202. Revision 1.12 1998/07/30 13:30:31 florian
  2203. * final implemenation of exception support, maybe it needs
  2204. some fixes :)
  2205. Revision 1.11 1998/07/24 22:16:52 florian
  2206. * internal error 10 together with array access fixed. I hope
  2207. that's the final fix.
  2208. Revision 1.10 1998/07/18 22:54:23 florian
  2209. * some ansi/wide/longstring support fixed:
  2210. o parameter passing
  2211. o returning as result from functions
  2212. Revision 1.9 1998/07/07 17:40:37 peter
  2213. * packrecords 4 works
  2214. * word aligning of parameters
  2215. Revision 1.8 1998/07/06 15:51:15 michael
  2216. Added length checking for string reading
  2217. Revision 1.7 1998/07/06 14:19:51 michael
  2218. + Added calls for reading/writing ansistrings
  2219. Revision 1.6 1998/07/01 15:28:48 peter
  2220. + better writeln/readln handling, now 100% like tp7
  2221. Revision 1.5 1998/06/25 14:04:17 peter
  2222. + internal inc/dec
  2223. Revision 1.4 1998/06/25 08:48:06 florian
  2224. * first version of rtti support
  2225. Revision 1.3 1998/06/09 16:01:33 pierre
  2226. + added procedure directive parsing for procvars
  2227. (accepted are popstack cdecl and pascal)
  2228. + added C vars with the following syntax
  2229. var C calias 'true_c_name';(can be followed by external)
  2230. reason is that you must add the Cprefix
  2231. which is target dependent
  2232. Revision 1.2 1998/06/08 13:13:29 pierre
  2233. + temporary variables now in temp_gen.pas unit
  2234. because it is processor independent
  2235. * mppc68k.bat modified to undefine i386 and support_mmx
  2236. (which are defaults for i386)
  2237. Revision 1.1 1998/06/05 17:44:10 peter
  2238. * splitted cgi386
  2239. }