cg386cal.pas 105 KB

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