n386inl.pas 72 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 by Florian Klaempfl
  4. Generate i386 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 n386inl;
  19. {$i defines.inc}
  20. interface
  21. uses
  22. node,ninl;
  23. type
  24. ti386inlinenode = class(tinlinenode)
  25. procedure pass_2;override;
  26. end;
  27. implementation
  28. uses
  29. globtype,systems,
  30. cutils,verbose,globals,fmodule,
  31. symconst,symbase,symtype,symdef,symsym,aasm,types,
  32. hcodegen,temp_gen,pass_1,pass_2,
  33. cpubase,
  34. nbas,ncon,ncal,ncnv,nld,
  35. cgai386,tgcpu,n386util;
  36. {*****************************************************************************
  37. Helpers
  38. *****************************************************************************}
  39. { reverts the parameter list }
  40. var nb_para : longint;
  41. function reversparameter(p : tnode) : tnode;
  42. var
  43. hp1,hp2 : tnode;
  44. begin
  45. hp1:=nil;
  46. nb_para := 0;
  47. while assigned(p) do
  48. begin
  49. { pull out }
  50. hp2:=p;
  51. p:=tbinarynode(p).right;
  52. inc(nb_para);
  53. { pull in }
  54. tbinarynode(hp2).right:=hp1;
  55. hp1:=hp2;
  56. end;
  57. reversparameter:=hp1;
  58. end;
  59. {*****************************************************************************
  60. TI386INLINENODE
  61. *****************************************************************************}
  62. procedure StoreDirectFuncResult(var dest:tnode);
  63. var
  64. hp : tnode;
  65. htype : ttype;
  66. hreg : tregister;
  67. hregister : tregister;
  68. oldregisterdef : boolean;
  69. op : tasmop;
  70. opsize : topsize;
  71. begin
  72. { Get the accumulator first so it can't be used in the dest }
  73. if (dest.resulttype.def.deftype=orddef) and
  74. not(is_64bitint(dest.resulttype.def)) then
  75. hregister:=getexplicitregister32(accumulator);
  76. { process dest }
  77. SecondPass(dest);
  78. if Codegenerror then
  79. exit;
  80. { store the value }
  81. Case dest.resulttype.def.deftype of
  82. floatdef:
  83. if dest.location.loc=LOC_CFPUREGISTER then
  84. begin
  85. floatstoreops(tfloatdef(dest.resulttype.def).typ,op,opsize);
  86. emit_reg(op,opsize,correct_fpuregister(dest.location.register,fpuvaroffset+1));
  87. end
  88. else
  89. begin
  90. inc(fpuvaroffset);
  91. floatstore(tfloatdef(dest.resulttype.def).typ,dest.location.reference);
  92. { floatstore decrements the fpu var offset }
  93. { but in fact we didn't increment it }
  94. end;
  95. orddef:
  96. begin
  97. if is_64bitint(dest.resulttype.def) then
  98. begin
  99. emit_movq_reg_loc(R_EDX,R_EAX,dest.location);
  100. end
  101. else
  102. begin
  103. Case dest.resulttype.def.size of
  104. 1 : hreg:=regtoreg8(hregister);
  105. 2 : hreg:=regtoreg16(hregister);
  106. 4 : hreg:=hregister;
  107. End;
  108. emit_mov_reg_loc(hreg,dest.location);
  109. If (cs_check_range in aktlocalswitches) and
  110. {no need to rangecheck longints or cardinals on 32bit processors}
  111. not((torddef(dest.resulttype.def).typ = s32bit) and
  112. (torddef(dest.resulttype.def).low = longint($80000000)) and
  113. (torddef(dest.resulttype.def).high = $7fffffff)) and
  114. not((torddef(dest.resulttype.def).typ = u32bit) and
  115. (torddef(dest.resulttype.def).low = 0) and
  116. (torddef(dest.resulttype.def).high = longint($ffffffff))) then
  117. Begin
  118. {do not register this temporary def}
  119. OldRegisterDef := RegisterDef;
  120. RegisterDef := False;
  121. htype.reset;
  122. Case torddef(dest.resulttype.def).typ of
  123. u8bit,u16bit,u32bit:
  124. begin
  125. htype.setdef(torddef.create(u32bit,0,longint($ffffffff)));
  126. hreg:=hregister;
  127. end;
  128. s8bit,s16bit,s32bit:
  129. begin
  130. htype.setdef(torddef.create(s32bit,longint($80000000),$7fffffff));
  131. hreg:=hregister;
  132. end;
  133. end;
  134. { create a fake node }
  135. hp := cnothingnode.create;
  136. hp.location.loc := LOC_REGISTER;
  137. hp.location.register := hreg;
  138. if assigned(htype.def) then
  139. hp.resulttype:=htype
  140. else
  141. hp.resulttype:=dest.resulttype;
  142. { emit the range check }
  143. emitrangecheck(hp,dest.resulttype.def);
  144. if assigned(htype.def) then
  145. htype.def.free;
  146. RegisterDef := OldRegisterDef;
  147. hp.free;
  148. End;
  149. ungetregister(hregister);
  150. end;
  151. End;
  152. else
  153. internalerror(66766766);
  154. end;
  155. { free used registers }
  156. del_locref(dest.location);
  157. end;
  158. procedure ti386inlinenode.pass_2;
  159. const
  160. {tfloattype = (s32real,s64real,s80real,s64bit,f16bit,f32bit);}
  161. { float_name: array[tfloattype] of string[8]=
  162. ('S32REAL','S64REAL','S80REAL','S64BIT','F16BIT','F32BIT'); }
  163. incdecop:array[in_inc_x..in_dec_x] of tasmop=(A_INC,A_DEC);
  164. addsubop:array[in_inc_x..in_dec_x] of tasmop=(A_ADD,A_SUB);
  165. var
  166. aktfile : treference;
  167. ft : tfiletyp;
  168. opsize : topsize;
  169. op,
  170. asmop : tasmop;
  171. pushed : tpushed;
  172. {inc/dec}
  173. addconstant : boolean;
  174. addvalue : longint;
  175. hp : tnode;
  176. procedure handlereadwrite(doread,doln : boolean);
  177. { produces code for READ(LN) and WRITE(LN) }
  178. procedure loadstream;
  179. const
  180. io:array[boolean] of string[6]=('OUTPUT','INPUT');
  181. var
  182. r : preference;
  183. begin
  184. new(r);
  185. reset_reference(r^);
  186. r^.symbol:=newasmsymbol(
  187. 'U_SYSTEM_'+io[doread]);
  188. getexplicitregister32(R_EDI);
  189. emit_ref_reg(A_LEA,S_L,r,R_EDI)
  190. end;
  191. const
  192. rdwrprefix:array[boolean] of string[15]=('FPC_WRITE_TEXT_','FPC_READ_TEXT_');
  193. var
  194. node : tcallparanode;
  195. hp : tnode;
  196. typedtyp,
  197. pararesult : tdef;
  198. orgfloattype : tfloattype;
  199. dummycoll : tparaitem;
  200. iolabel : tasmlabel;
  201. npara : longint;
  202. esireloaded : boolean;
  203. label
  204. myexit;
  205. begin
  206. { here we don't use register calling conventions }
  207. dummycoll:=TParaItem.Create;
  208. dummycoll.register:=R_NO;
  209. { I/O check }
  210. if (cs_check_io in aktlocalswitches) and
  211. not(po_iocheck in aktprocsym.definition.procoptions) then
  212. begin
  213. getaddrlabel(iolabel);
  214. emitlab(iolabel);
  215. end
  216. else
  217. iolabel:=nil;
  218. { for write of real with the length specified }
  219. hp:=nil;
  220. { reserve temporary pointer to data variable }
  221. aktfile.symbol:=nil;
  222. gettempofsizereference(4,aktfile);
  223. { first state text data }
  224. ft:=ft_text;
  225. { and state a parameter ? }
  226. if left=nil then
  227. begin
  228. { the following instructions are for "writeln;" }
  229. loadstream;
  230. { save @aktfile in temporary variable }
  231. emit_reg_ref(A_MOV,S_L,R_EDI,newreference(aktfile));
  232. ungetregister32(R_EDI);
  233. end
  234. else
  235. begin
  236. { revers paramters }
  237. node:=tcallparanode(reversparameter(left));
  238. left := node;
  239. npara := nb_para;
  240. { calculate data variable }
  241. { is first parameter a file type ? }
  242. if node.left.resulttype.def.deftype=filedef then
  243. begin
  244. ft:=tfiledef(node.left.resulttype.def).filetyp;
  245. if ft=ft_typed then
  246. typedtyp:=tfiledef(node.left.resulttype.def).typedfiletype.def;
  247. secondpass(node.left);
  248. if codegenerror then
  249. goto myexit;
  250. { save reference in temporary variables }
  251. if node.left.location.loc<>LOC_REFERENCE then
  252. begin
  253. CGMessage(cg_e_illegal_expression);
  254. goto myexit;
  255. end;
  256. getexplicitregister32(R_EDI);
  257. emit_ref_reg(A_LEA,S_L,newreference(node.left.location.reference),R_EDI);
  258. del_reference(node.left.location.reference);
  259. { skip to the next parameter }
  260. node:=tcallparanode(node.right);
  261. end
  262. else
  263. begin
  264. { load stdin/stdout stream }
  265. loadstream;
  266. end;
  267. { save @aktfile in temporary variable }
  268. emit_reg_ref(A_MOV,S_L,R_EDI,newreference(aktfile));
  269. ungetregister32(R_EDI);
  270. if doread then
  271. { parameter by READ gives call by reference }
  272. dummycoll.paratyp:=vs_var
  273. { an WRITE Call by "Const" }
  274. else
  275. dummycoll.paratyp:=vs_const;
  276. { because of secondcallparan, which otherwise attaches }
  277. if ft=ft_typed then
  278. { this is to avoid copy of simple const parameters }
  279. {dummycoll.data:=new(pformaldef.create)}
  280. dummycoll.paratype:=cformaltype
  281. else
  282. { I think, this isn't a good solution (FK) }
  283. dummycoll.paratype.reset;
  284. while assigned(node) do
  285. begin
  286. esireloaded:=false;
  287. pushusedregisters(pushed,$ff);
  288. hp:=node;
  289. node:=tcallparanode(node.right);
  290. tcallparanode(hp).right:=nil;
  291. if cpf_is_colon_para in tcallparanode(hp).callparaflags then
  292. CGMessage(parser_e_illegal_colon_qualifier);
  293. { when float is written then we need bestreal to be pushed
  294. convert here else we loose the old float type }
  295. if (not doread) and
  296. (ft<>ft_typed) and
  297. (tcallparanode(hp).left.resulttype.def.deftype=floatdef) then
  298. begin
  299. orgfloattype:=tfloatdef(tcallparanode(hp).left.resulttype.def).typ;
  300. tcallparanode(hp).left:=ctypeconvnode.create(tcallparanode(hp).left,pbestrealtype^);
  301. firstpass(tcallparanode(hp).left);
  302. end;
  303. { when read ord,floats are functions, so they need this
  304. parameter as their destination instead of being pushed }
  305. if doread and
  306. (ft<>ft_typed) and
  307. (tcallparanode(hp).resulttype.def.deftype in [orddef,floatdef]) then
  308. begin
  309. end
  310. else
  311. begin
  312. if ft=ft_typed then
  313. never_copy_const_param:=true;
  314. { reset data type }
  315. dummycoll.paratype.reset;
  316. { create temporary defs for high tree generation }
  317. if doread and (is_shortstring(tcallparanode(hp).resulttype.def)) then
  318. dummycoll.paratype:=openshortstringtype
  319. else
  320. if (is_chararray(tcallparanode(hp).resulttype.def)) then
  321. dummycoll.paratype:=openchararraytype;
  322. tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
  323. if ft=ft_typed then
  324. never_copy_const_param:=false;
  325. end;
  326. tcallparanode(hp).right:=node;
  327. if codegenerror then
  328. goto myexit;
  329. emit_push_mem(aktfile);
  330. if (ft=ft_typed) then
  331. begin
  332. { OK let's try this }
  333. { first we must only allow the right type }
  334. { we have to call blockread or blockwrite }
  335. { but the real problem is that }
  336. { reset and rewrite should have set }
  337. { the type size }
  338. { as recordsize for that file !!!! }
  339. { how can we make that }
  340. { I think that is only possible by adding }
  341. { reset and rewrite to the inline list a call }
  342. { allways read only one record by element }
  343. push_int(typedtyp.size);
  344. saveregvars($ff);
  345. if doread then
  346. emitcall('FPC_TYPED_READ')
  347. else
  348. emitcall('FPC_TYPED_WRITE');
  349. end
  350. else
  351. begin
  352. { save current position }
  353. pararesult:=tcallparanode(hp).left.resulttype.def;
  354. { handle possible field width }
  355. { of course only for write(ln) }
  356. if not doread then
  357. begin
  358. { handle total width parameter }
  359. if assigned(node) and (cpf_is_colon_para in node.callparaflags) then
  360. begin
  361. hp:=node;
  362. node:=tcallparanode(node.right);
  363. tcallparanode(hp).right:=nil;
  364. dummycoll.paratype.setdef(hp.resulttype.def);
  365. dummycoll.paratyp:=vs_value;
  366. tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
  367. tcallparanode(hp).right:=node;
  368. if codegenerror then
  369. goto myexit;
  370. end
  371. else
  372. if pararesult.deftype<>floatdef then
  373. push_int(0)
  374. else
  375. push_int(-32767);
  376. { a second colon para for a float ? }
  377. if assigned(node) and (cpf_is_colon_para in node.callparaflags) then
  378. begin
  379. hp:=node;
  380. node:=tcallparanode(node.right);
  381. tcallparanode(hp).right:=nil;
  382. dummycoll.paratype.setdef(hp.resulttype.def);
  383. dummycoll.paratyp:=vs_value;
  384. tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
  385. tcallparanode(hp).right:=node;
  386. if pararesult.deftype<>floatdef then
  387. CGMessage(parser_e_illegal_colon_qualifier);
  388. if codegenerror then
  389. goto myexit;
  390. end
  391. else
  392. begin
  393. if pararesult.deftype=floatdef then
  394. push_int(-1);
  395. end;
  396. { push also the real type for floats }
  397. if pararesult.deftype=floatdef then
  398. push_int(ord(orgfloattype));
  399. end;
  400. saveregvars($ff);
  401. case pararesult.deftype of
  402. stringdef :
  403. begin
  404. emitcall(rdwrprefix[doread]+tstringdef(pararesult).stringtypname);
  405. end;
  406. pointerdef :
  407. begin
  408. if is_pchar(pararesult) then
  409. emitcall(rdwrprefix[doread]+'PCHAR_AS_POINTER')
  410. end;
  411. arraydef :
  412. begin
  413. if is_chararray(pararesult) then
  414. emitcall(rdwrprefix[doread]+'PCHAR_AS_ARRAY')
  415. end;
  416. floatdef :
  417. begin
  418. emitcall(rdwrprefix[doread]+'FLOAT');
  419. {
  420. if tfloatdef(resulttype.def).typ<>f32bit then
  421. dec(fpuvaroffset);
  422. }
  423. if doread then
  424. begin
  425. maybe_loadself;
  426. esireloaded:=true;
  427. StoreDirectFuncResult(tcallparanode(hp).left);
  428. end;
  429. end;
  430. orddef :
  431. begin
  432. case torddef(pararesult).typ of
  433. s8bit,s16bit,s32bit :
  434. emitcall(rdwrprefix[doread]+'SINT');
  435. u8bit,u16bit,u32bit :
  436. emitcall(rdwrprefix[doread]+'UINT');
  437. uchar :
  438. emitcall(rdwrprefix[doread]+'CHAR');
  439. s64bit :
  440. emitcall(rdwrprefix[doread]+'INT64');
  441. u64bit :
  442. emitcall(rdwrprefix[doread]+'QWORD');
  443. bool8bit,
  444. bool16bit,
  445. bool32bit :
  446. emitcall(rdwrprefix[doread]+'BOOLEAN');
  447. end;
  448. if doread then
  449. begin
  450. maybe_loadself;
  451. esireloaded:=true;
  452. StoreDirectFuncResult(tcallparanode(hp).left);
  453. end;
  454. end;
  455. end;
  456. end;
  457. { load ESI in methods again }
  458. popusedregisters(pushed);
  459. if not(esireloaded) then
  460. maybe_loadself;
  461. end;
  462. end;
  463. { Insert end of writing for textfiles }
  464. if ft=ft_text then
  465. begin
  466. pushusedregisters(pushed,$ff);
  467. emit_push_mem(aktfile);
  468. saveregvars($ff);
  469. if doread then
  470. begin
  471. if doln then
  472. emitcall('FPC_READLN_END')
  473. else
  474. emitcall('FPC_READ_END');
  475. end
  476. else
  477. begin
  478. if doln then
  479. emitcall('FPC_WRITELN_END')
  480. else
  481. emitcall('FPC_WRITE_END');
  482. end;
  483. popusedregisters(pushed);
  484. maybe_loadself;
  485. end;
  486. { Insert IOCheck if set }
  487. if assigned(iolabel) then
  488. begin
  489. { registers are saved in the procedure }
  490. emit_sym(A_PUSH,S_L,iolabel);
  491. emitcall('FPC_IOCHECK');
  492. end;
  493. { Freeup all used temps }
  494. ungetiftemp(aktfile);
  495. if assigned(left) then
  496. begin
  497. left:=reversparameter(left);
  498. if npara<>nb_para then
  499. CGMessage(cg_f_internal_error_in_secondinline);
  500. hp:=left;
  501. while assigned(hp) do
  502. begin
  503. if assigned(tcallparanode(hp).left) then
  504. if (tcallparanode(hp).left.location.loc in [LOC_MEM,LOC_REFERENCE]) then
  505. ungetiftemp(tcallparanode(hp).left.location.reference);
  506. hp:=tcallparanode(hp).right;
  507. end;
  508. end;
  509. myexit:
  510. dummycoll.free;
  511. end;
  512. procedure handle_str;
  513. var
  514. hp,
  515. node : tcallparanode;
  516. dummycoll : tparaitem;
  517. //hp2 : tstringconstnode;
  518. is_real : boolean;
  519. realtype : tfloattype;
  520. procedureprefix : string;
  521. label
  522. myexit;
  523. begin
  524. dummycoll:=TParaItem.Create;
  525. dummycoll.register:=R_NO;
  526. pushusedregisters(pushed,$ff);
  527. node:=tcallparanode(left);
  528. is_real:=false;
  529. while assigned(node.right) do node:=tcallparanode(node.right);
  530. { if a real parameter somewhere then call REALSTR }
  531. if (node.left.resulttype.def.deftype=floatdef) then
  532. begin
  533. is_real:=true;
  534. realtype:=tfloatdef(node.left.resulttype.def).typ;
  535. end;
  536. node:=tcallparanode(left);
  537. { we have at least two args }
  538. { with at max 2 colon_para in between }
  539. { string arg }
  540. hp:=node;
  541. node:=tcallparanode(node.right);
  542. hp.right:=nil;
  543. dummycoll.paratyp:=vs_var;
  544. if is_shortstring(hp.resulttype.def) then
  545. dummycoll.paratype:=openshortstringtype
  546. else
  547. dummycoll.paratype:=hp.resulttype;
  548. procedureprefix:='FPC_'+tstringdef(hp.resulttype.def).stringtypname+'_';
  549. tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
  550. if codegenerror then
  551. goto myexit;
  552. dummycoll.paratyp:=vs_const;
  553. left.free;
  554. left:=nil;
  555. { second arg }
  556. hp:=node;
  557. node:=tcallparanode(node.right);
  558. hp.right:=nil;
  559. { if real push real type }
  560. if is_real then
  561. push_int(ord(realtype));
  562. { frac para }
  563. if (cpf_is_colon_para in hp.callparaflags) and assigned(node) and
  564. (cpf_is_colon_para in node.callparaflags) then
  565. begin
  566. dummycoll.paratype.setdef(hp.resulttype.def);
  567. dummycoll.paratyp:=vs_value;
  568. tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
  569. if codegenerror then
  570. goto myexit;
  571. hp.free;
  572. hp:=node;
  573. node:=tcallparanode(node.right);
  574. hp.right:=nil;
  575. end
  576. else
  577. if is_real then
  578. push_int(-1);
  579. { third arg, length only if is_real }
  580. if (cpf_is_colon_para in hp.callparaflags) then
  581. begin
  582. dummycoll.paratype.setdef(hp.resulttype.def);
  583. dummycoll.paratyp:=vs_value;
  584. tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
  585. if codegenerror then
  586. goto myexit;
  587. hp.free;
  588. hp:=node;
  589. node:=tcallparanode(node.right);
  590. hp.right:=nil;
  591. end
  592. else
  593. if is_real then
  594. push_int(-32767)
  595. else
  596. push_int(-1);
  597. { Convert float to bestreal }
  598. if is_real then
  599. begin
  600. hp.left:=ctypeconvnode.create(hp.left,pbestrealtype^);
  601. firstpass(hp.left);
  602. end;
  603. { last arg longint or real }
  604. dummycoll.paratype.setdef(hp.resulttype.def);
  605. dummycoll.paratyp:=vs_value;
  606. tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
  607. if codegenerror then
  608. goto myexit;
  609. saveregvars($ff);
  610. if is_real then
  611. emitcall(procedureprefix+'FLOAT')
  612. else
  613. case torddef(hp.resulttype.def).typ of
  614. u32bit:
  615. emitcall(procedureprefix+'CARDINAL');
  616. u64bit:
  617. emitcall(procedureprefix+'QWORD');
  618. s64bit:
  619. emitcall(procedureprefix+'INT64');
  620. else
  621. emitcall(procedureprefix+'LONGINT');
  622. end;
  623. popusedregisters(pushed);
  624. hp.free;
  625. myexit:
  626. dummycoll.free;
  627. end;
  628. Procedure Handle_Val;
  629. var
  630. hp,node,
  631. code_para, dest_para : tcallparanode;
  632. hreg,hreg2: TRegister;
  633. hdef: torddef;
  634. procedureprefix : string;
  635. hr, hr2: TReference;
  636. dummycoll : tparaitem;
  637. has_code, has_32bit_code, oldregisterdef: boolean;
  638. r : preference;
  639. label
  640. myexit;
  641. begin
  642. dummycoll:=TParaItem.Create;
  643. dummycoll.register:=R_NO;
  644. node:=tcallparanode(left);
  645. hp:=node;
  646. node:=tcallparanode(node.right);
  647. hp.right:=nil;
  648. {if we have 3 parameters, we have a code parameter}
  649. has_code := Assigned(node.right);
  650. has_32bit_code := false;
  651. reset_reference(hr);
  652. hreg := R_NO;
  653. If has_code then
  654. Begin
  655. {code is an orddef, that's checked in tcinl}
  656. code_para := hp;
  657. hp := node;
  658. node := tcallparanode(node.right);
  659. hp.right := nil;
  660. has_32bit_code := (torddef(tcallparanode(code_para).left.resulttype.def).typ in [u32bit,s32bit]);
  661. End;
  662. {hp = destination now, save for later use}
  663. dest_para := hp;
  664. {if EAX is already in use, it's a register variable. Since we don't
  665. need another register besides EAX, release the one we got}
  666. If hreg <> R_EAX Then ungetregister32(hreg);
  667. {load and push the address of the destination}
  668. dummycoll.paratyp:=vs_var;
  669. dummycoll.paratype.setdef(dest_para.resulttype.def);
  670. dest_para.secondcallparan(dummycoll,false,false,false,0,0);
  671. if codegenerror then
  672. goto myexit;
  673. {save the regvars}
  674. pushusedregisters(pushed,$ff);
  675. {now that we've already pushed the addres of dest_para.left on the
  676. stack, we can put the real parameters on the stack}
  677. If has_32bit_code Then
  678. Begin
  679. dummycoll.paratyp:=vs_var;
  680. dummycoll.paratype.setdef(code_para.resulttype.def);
  681. code_para.secondcallparan(dummycoll,false,false,false,0,0);
  682. if codegenerror then
  683. goto myexit;
  684. code_para.free;
  685. End
  686. Else
  687. Begin
  688. {only 32bit code parameter is supported, so fake one}
  689. GetTempOfSizeReference(4,hr);
  690. emitpushreferenceaddr(hr);
  691. End;
  692. {node = first parameter = string}
  693. dummycoll.paratyp:=vs_const;
  694. dummycoll.paratype.setdef(node.resulttype.def);
  695. node.secondcallparan(dummycoll,false,false,false,0,0);
  696. if codegenerror then
  697. goto myexit;
  698. Case dest_para.resulttype.def.deftype of
  699. floatdef:
  700. begin
  701. procedureprefix := 'FPC_VAL_REAL_';
  702. inc(fpuvaroffset);
  703. end;
  704. orddef:
  705. if is_64bitint(dest_para.resulttype.def) then
  706. begin
  707. if is_signed(dest_para.resulttype.def) then
  708. procedureprefix := 'FPC_VAL_INT64_'
  709. else
  710. procedureprefix := 'FPC_VAL_QWORD_';
  711. end
  712. else
  713. begin
  714. if is_signed(dest_para.resulttype.def) then
  715. begin
  716. {if we are converting to a signed number, we have to include the
  717. size of the destination, so the Val function can extend the sign
  718. of the result to allow proper range checking}
  719. emit_const(A_PUSH,S_L,dest_para.resulttype.def.size);
  720. procedureprefix := 'FPC_VAL_SINT_'
  721. end
  722. else
  723. procedureprefix := 'FPC_VAL_UINT_';
  724. end;
  725. End;
  726. saveregvars($ff);
  727. emitcall(procedureprefix+tstringdef(node.resulttype.def).stringtypname);
  728. { before disposing node we need to ungettemp !! PM }
  729. if node.left.location.loc in [LOC_REFERENCE,LOC_MEM] then
  730. ungetiftemp(node.left.location.reference);
  731. node.free;
  732. left := nil;
  733. {reload esi in case the dest_para/code_para is a class variable or so}
  734. maybe_loadself;
  735. If (dest_para.resulttype.def.deftype = orddef) Then
  736. Begin
  737. {store the result in a safe place, because EAX may be used by a
  738. register variable}
  739. hreg := getexplicitregister32(R_EAX);
  740. emit_reg_reg(A_MOV,S_L,R_EAX,hreg);
  741. if is_64bitint(dest_para.resulttype.def) then
  742. begin
  743. hreg2:=getexplicitregister32(R_EDX);
  744. emit_reg_reg(A_MOV,S_L,R_EDX,hreg2);
  745. end;
  746. {as of now, hreg now holds the location of the result, if it was
  747. integer}
  748. End;
  749. { restore the register vars}
  750. popusedregisters(pushed);
  751. If has_code and Not(has_32bit_code) Then
  752. {only 16bit code is possible}
  753. Begin
  754. {load the address of the code parameter}
  755. secondpass(code_para.left);
  756. {move the code to its destination}
  757. getexplicitregister32(R_EDI);
  758. emit_ref_reg(A_MOV,S_L,NewReference(hr),R_EDI);
  759. emit_mov_reg_loc(R_DI,code_para.left.location);
  760. ungetregister32(R_EDI);
  761. code_para.free;
  762. End;
  763. {restore the address of the result}
  764. getexplicitregister32(R_EDI);
  765. emit_reg(A_POP,S_L,R_EDI);
  766. {set up hr2 to a refernce with EDI as base register}
  767. reset_reference(hr2);
  768. hr2.base := R_EDI;
  769. {save the function result in the destination variable}
  770. Case dest_para.left.resulttype.def.deftype of
  771. floatdef:
  772. floatstore(tfloatdef(dest_para.left.resulttype.def).typ, hr2);
  773. orddef:
  774. Case torddef(dest_para.left.resulttype.def).typ of
  775. u8bit,s8bit:
  776. emit_reg_ref(A_MOV, S_B,
  777. RegToReg8(hreg),newreference(hr2));
  778. u16bit,s16bit:
  779. emit_reg_ref(A_MOV, S_W,
  780. RegToReg16(hreg),newreference(hr2));
  781. u32bit,s32bit:
  782. emit_reg_ref(A_MOV, S_L,
  783. hreg,newreference(hr2));
  784. u64bit,s64bit:
  785. begin
  786. emit_reg_ref(A_MOV, S_L,
  787. hreg,newreference(hr2));
  788. r:=newreference(hr2);
  789. inc(r^.offset,4);
  790. emit_reg_ref(A_MOV, S_L,
  791. hreg2,r);
  792. end;
  793. End;
  794. End;
  795. ungetregister32(R_EDI);
  796. If (cs_check_range in aktlocalswitches) and
  797. (dest_para.left.resulttype.def.deftype = orddef) and
  798. (not(is_64bitint(dest_para.left.resulttype.def))) and
  799. {the following has to be changed to 64bit checking, once Val
  800. returns 64 bit values (unless a special Val function is created
  801. for that)}
  802. {no need to rangecheck longints or cardinals on 32bit processors}
  803. not((torddef(dest_para.left.resulttype.def).typ = s32bit) and
  804. (torddef(dest_para.left.resulttype.def).low = longint($80000000)) and
  805. (torddef(dest_para.left.resulttype.def).high = $7fffffff)) and
  806. not((torddef(dest_para.left.resulttype.def).typ = u32bit) and
  807. (torddef(dest_para.left.resulttype.def).low = 0) and
  808. (torddef(dest_para.left.resulttype.def).high = longint($ffffffff))) then
  809. Begin
  810. hp:=tcallparanode(dest_para.left.getcopy);
  811. hp.location.loc := LOC_REGISTER;
  812. hp.location.register := hreg;
  813. {do not register this temporary def}
  814. OldRegisterDef := RegisterDef;
  815. RegisterDef := False;
  816. Case torddef(dest_para.left.resulttype.def).typ of
  817. u8bit,u16bit,u32bit: hdef:=torddef.create(u32bit,0,longint($ffffffff));
  818. s8bit,s16bit,s32bit: hdef:=torddef.create(s32bit,longint($80000000),$7fffffff);
  819. end;
  820. hp.resulttype.def := hdef;
  821. emitrangecheck(hp,dest_para.left.resulttype.def);
  822. hp.right := nil;
  823. hp.resulttype.def.free;
  824. RegisterDef := OldRegisterDef;
  825. hp.free;
  826. End;
  827. {dest_para.right is already nil}
  828. dest_para.free;
  829. UnGetIfTemp(hr);
  830. myexit:
  831. dummycoll.free;
  832. end;
  833. var
  834. r : preference;
  835. //hp : tcallparanode;
  836. hp2 : tstringconstnode;
  837. dummycoll : tparaitem;
  838. l : longint;
  839. ispushed : boolean;
  840. hregister : tregister;
  841. otlabel,oflabel{,l1} : tasmlabel;
  842. oldpushedparasize : longint;
  843. def : tdef;
  844. hr,hr2 : treference;
  845. begin
  846. { save & reset pushedparasize }
  847. oldpushedparasize:=pushedparasize;
  848. pushedparasize:=0;
  849. case inlinenumber of
  850. in_assert_x_y:
  851. begin
  852. { the node should be removed in the firstpass }
  853. if not (cs_do_assertion in aktlocalswitches) then
  854. internalerror(7123458);
  855. otlabel:=truelabel;
  856. oflabel:=falselabel;
  857. getlabel(truelabel);
  858. getlabel(falselabel);
  859. secondpass(tcallparanode(left).left);
  860. maketojumpbool(tcallparanode(left).left);
  861. emitlab(falselabel);
  862. { erroraddr }
  863. emit_reg(A_PUSH,S_L,R_EBP);
  864. { lineno }
  865. emit_const(A_PUSH,S_L,aktfilepos.line);
  866. { filename string }
  867. hp2:=cstringconstnode.createstr(current_module.sourcefiles.get_file_name(aktfilepos.fileindex),st_shortstring);
  868. firstpass(hp2);
  869. secondpass(hp2);
  870. if codegenerror then
  871. exit;
  872. emitpushreferenceaddr(hp2.location.reference);
  873. hp2.free;
  874. { push msg }
  875. secondpass(tcallparanode(tcallparanode(left).right).left);
  876. emitpushreferenceaddr(tcallparanode(tcallparanode(left).right).left.location.reference);
  877. { call }
  878. emitcall('FPC_ASSERT');
  879. emitlab(truelabel);
  880. truelabel:=otlabel;
  881. falselabel:=oflabel;
  882. end;
  883. in_lo_word,
  884. in_hi_word :
  885. begin
  886. secondpass(left);
  887. location.loc:=LOC_REGISTER;
  888. if left.location.loc<>LOC_REGISTER then
  889. begin
  890. if left.location.loc=LOC_CREGISTER then
  891. begin
  892. location.register:=reg32toreg16(getregister32);
  893. emit_reg_reg(A_MOV,S_W,left.location.register,
  894. location.register);
  895. end
  896. else
  897. begin
  898. del_reference(left.location.reference);
  899. location.register:=reg32toreg16(getregister32);
  900. emit_ref_reg(A_MOV,S_W,newreference(left.location.reference),
  901. location.register);
  902. end;
  903. end
  904. else location.register:=left.location.register;
  905. if inlinenumber=in_hi_word then
  906. emit_const_reg(A_SHR,S_W,8,location.register);
  907. location.register:=reg16toreg8(location.register);
  908. end;
  909. in_sizeof_x,
  910. in_typeof_x :
  911. begin
  912. { for both cases load vmt }
  913. if left.nodetype=typen then
  914. begin
  915. location.register:=getregister32;
  916. emit_sym_ofs_reg(A_MOV,
  917. S_L,newasmsymbol(tobjectdef(left.resulttype.def).vmt_mangledname),0,
  918. location.register);
  919. end
  920. else
  921. begin
  922. secondpass(left);
  923. del_reference(left.location.reference);
  924. location.loc:=LOC_REGISTER;
  925. location.register:=getregister32;
  926. { load VMT pointer }
  927. inc(left.location.reference.offset,
  928. tobjectdef(left.resulttype.def).vmt_offset);
  929. emit_ref_reg(A_MOV,S_L,
  930. newreference(left.location.reference),
  931. location.register);
  932. end;
  933. { in sizeof load size }
  934. if inlinenumber=in_sizeof_x then
  935. begin
  936. new(r);
  937. reset_reference(r^);
  938. r^.base:=location.register;
  939. emit_ref_reg(A_MOV,S_L,r,
  940. location.register);
  941. end;
  942. end;
  943. in_lo_long,
  944. in_hi_long :
  945. begin
  946. secondpass(left);
  947. location.loc:=LOC_REGISTER;
  948. if left.location.loc<>LOC_REGISTER then
  949. begin
  950. if left.location.loc=LOC_CREGISTER then
  951. begin
  952. location.register:=getregister32;
  953. emit_reg_reg(A_MOV,S_L,left.location.register,
  954. location.register);
  955. end
  956. else
  957. begin
  958. del_reference(left.location.reference);
  959. location.register:=getregister32;
  960. emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
  961. location.register);
  962. end;
  963. end
  964. else location.register:=left.location.register;
  965. if inlinenumber=in_hi_long then
  966. emit_const_reg(A_SHR,S_L,16,location.register);
  967. location.register:=reg32toreg16(location.register);
  968. end;
  969. in_lo_qword,
  970. in_hi_qword:
  971. begin
  972. secondpass(left);
  973. location.loc:=LOC_REGISTER;
  974. case left.location.loc of
  975. LOC_CREGISTER:
  976. begin
  977. location.register:=getregister32;
  978. if inlinenumber=in_hi_qword then
  979. emit_reg_reg(A_MOV,S_L,left.location.registerhigh,
  980. location.register)
  981. else
  982. emit_reg_reg(A_MOV,S_L,left.location.registerlow,
  983. location.register)
  984. end;
  985. LOC_MEM,LOC_REFERENCE:
  986. begin
  987. del_reference(left.location.reference);
  988. location.register:=getregister32;
  989. r:=newreference(left.location.reference);
  990. if inlinenumber=in_hi_qword then
  991. inc(r^.offset,4);
  992. emit_ref_reg(A_MOV,S_L,
  993. r,location.register);
  994. end;
  995. LOC_REGISTER:
  996. begin
  997. if inlinenumber=in_hi_qword then
  998. begin
  999. location.register:=left.location.registerhigh;
  1000. ungetregister32(left.location.registerlow);
  1001. end
  1002. else
  1003. begin
  1004. location.register:=left.location.registerlow;
  1005. ungetregister32(left.location.registerhigh);
  1006. end;
  1007. end;
  1008. end;
  1009. end;
  1010. in_length_string :
  1011. begin
  1012. secondpass(left);
  1013. set_location(location,left.location);
  1014. { length in ansi strings is at offset -8 }
  1015. if is_ansistring(left.resulttype.def) then
  1016. dec(location.reference.offset,8)
  1017. { char is always 1, so make it a constant value }
  1018. else if is_char(left.resulttype.def) then
  1019. begin
  1020. clear_location(location);
  1021. location.loc:=LOC_MEM;
  1022. location.reference.is_immediate:=true;
  1023. location.reference.offset:=1;
  1024. end;
  1025. end;
  1026. in_pred_x,
  1027. in_succ_x:
  1028. begin
  1029. secondpass(left);
  1030. if not (cs_check_overflow in aktlocalswitches) then
  1031. if inlinenumber=in_pred_x then
  1032. asmop:=A_DEC
  1033. else
  1034. asmop:=A_INC
  1035. else
  1036. if inlinenumber=in_pred_x then
  1037. asmop:=A_SUB
  1038. else
  1039. asmop:=A_ADD;
  1040. case resulttype.def.size of
  1041. 8 : opsize:=S_L;
  1042. 4 : opsize:=S_L;
  1043. 2 : opsize:=S_W;
  1044. 1 : opsize:=S_B;
  1045. else
  1046. internalerror(10080);
  1047. end;
  1048. location.loc:=LOC_REGISTER;
  1049. if resulttype.def.size=8 then
  1050. begin
  1051. if left.location.loc<>LOC_REGISTER then
  1052. begin
  1053. if left.location.loc=LOC_CREGISTER then
  1054. begin
  1055. location.registerlow:=getregister32;
  1056. location.registerhigh:=getregister32;
  1057. emit_reg_reg(A_MOV,opsize,left.location.registerlow,
  1058. location.registerlow);
  1059. emit_reg_reg(A_MOV,opsize,left.location.registerhigh,
  1060. location.registerhigh);
  1061. end
  1062. else
  1063. begin
  1064. del_reference(left.location.reference);
  1065. location.registerlow:=getregister32;
  1066. location.registerhigh:=getregister32;
  1067. emit_ref_reg(A_MOV,opsize,newreference(left.location.reference),
  1068. location.registerlow);
  1069. r:=newreference(left.location.reference);
  1070. inc(r^.offset,4);
  1071. emit_ref_reg(A_MOV,opsize,r,
  1072. location.registerhigh);
  1073. end;
  1074. end
  1075. else
  1076. begin
  1077. location.registerhigh:=left.location.registerhigh;
  1078. location.registerlow:=left.location.registerlow;
  1079. end;
  1080. if inlinenumber=in_succ_x then
  1081. begin
  1082. emit_const_reg(A_ADD,opsize,1,
  1083. location.registerlow);
  1084. emit_const_reg(A_ADC,opsize,0,
  1085. location.registerhigh);
  1086. end
  1087. else
  1088. begin
  1089. emit_const_reg(A_SUB,opsize,1,
  1090. location.registerlow);
  1091. emit_const_reg(A_SBB,opsize,0,
  1092. location.registerhigh);
  1093. end;
  1094. end
  1095. else
  1096. begin
  1097. if left.location.loc<>LOC_REGISTER then
  1098. begin
  1099. { first, we've to release the source location ... }
  1100. if left.location.loc in [LOC_MEM,LOC_REFERENCE] then
  1101. del_reference(left.location.reference);
  1102. location.register:=getregister32;
  1103. if (resulttype.def.size=2) then
  1104. location.register:=reg32toreg16(location.register);
  1105. if (resulttype.def.size=1) then
  1106. location.register:=reg32toreg8(location.register);
  1107. if left.location.loc=LOC_CREGISTER then
  1108. emit_reg_reg(A_MOV,opsize,left.location.register,
  1109. location.register)
  1110. else
  1111. if left.location.loc=LOC_FLAGS then
  1112. emit_flag2reg(left.location.resflags,location.register)
  1113. else
  1114. emit_ref_reg(A_MOV,opsize,newreference(left.location.reference),
  1115. location.register);
  1116. end
  1117. else location.register:=left.location.register;
  1118. if not (cs_check_overflow in aktlocalswitches) then
  1119. emit_reg(asmop,opsize,
  1120. location.register)
  1121. else
  1122. emit_const_reg(asmop,opsize,1,
  1123. location.register);
  1124. end;
  1125. emitoverflowcheck(self);
  1126. emitrangecheck(self,resulttype.def);
  1127. end;
  1128. in_dec_x,
  1129. in_inc_x :
  1130. begin
  1131. { set defaults }
  1132. addvalue:=1;
  1133. addconstant:=true;
  1134. { load first parameter, must be a reference }
  1135. secondpass(tcallparanode(left).left);
  1136. case tcallparanode(left).left.resulttype.def.deftype of
  1137. orddef,
  1138. enumdef : begin
  1139. case tcallparanode(left).left.resulttype.def.size of
  1140. 1 : opsize:=S_B;
  1141. 2 : opsize:=S_W;
  1142. 4 : opsize:=S_L;
  1143. 8 : opsize:=S_L;
  1144. end;
  1145. end;
  1146. pointerdef : begin
  1147. opsize:=S_L;
  1148. if is_void(tpointerdef(tcallparanode(left).left.resulttype.def).pointertype.def) then
  1149. addvalue:=1
  1150. else
  1151. addvalue:=tpointerdef(tcallparanode(left).left.resulttype.def).pointertype.def.size;
  1152. end;
  1153. else
  1154. internalerror(10081);
  1155. end;
  1156. { second argument specified?, must be a s32bit in register }
  1157. if assigned(tcallparanode(left).right) then
  1158. begin
  1159. ispushed:=maybe_push(tcallparanode(tcallparanode(left).right).left.registers32,
  1160. tcallparanode(left).left,false);
  1161. secondpass(tcallparanode(tcallparanode(left).right).left);
  1162. if ispushed then
  1163. restore(tcallparanode(left).left,false);
  1164. { when constant, just multiply the addvalue }
  1165. if is_constintnode(tcallparanode(tcallparanode(left).right).left) then
  1166. addvalue:=addvalue*get_ordinal_value(tcallparanode(tcallparanode(left).right).left)
  1167. else
  1168. begin
  1169. case tcallparanode(tcallparanode(left).right).left.location.loc of
  1170. LOC_REGISTER,
  1171. LOC_CREGISTER : hregister:=tcallparanode(tcallparanode(left).right).left.location.register;
  1172. LOC_MEM,
  1173. LOC_REFERENCE : begin
  1174. del_reference(tcallparanode(tcallparanode(left).right).left.location.reference);
  1175. hregister:=getregister32;
  1176. emit_ref_reg(A_MOV,S_L,
  1177. newreference(tcallparanode(tcallparanode(left).right).left.location.reference),hregister);
  1178. end;
  1179. else
  1180. internalerror(10082);
  1181. end;
  1182. { insert multiply with addvalue if its >1 }
  1183. if addvalue>1 then
  1184. emit_const_reg(A_IMUL,opsize,
  1185. addvalue,hregister);
  1186. addconstant:=false;
  1187. end;
  1188. end;
  1189. { write the add instruction }
  1190. if addconstant then
  1191. begin
  1192. if (addvalue=1) and not(cs_check_overflow in aktlocalswitches) then
  1193. begin
  1194. if tcallparanode(left).left.location.loc=LOC_CREGISTER then
  1195. emit_reg(incdecop[inlinenumber],opsize,
  1196. tcallparanode(left).left.location.register)
  1197. else
  1198. emit_ref(incdecop[inlinenumber],opsize,
  1199. newreference(tcallparanode(left).left.location.reference))
  1200. end
  1201. else
  1202. begin
  1203. if tcallparanode(left).left.location.loc=LOC_CREGISTER then
  1204. emit_const_reg(addsubop[inlinenumber],opsize,
  1205. addvalue,tcallparanode(left).left.location.register)
  1206. else
  1207. emit_const_ref(addsubop[inlinenumber],opsize,
  1208. addvalue,newreference(tcallparanode(left).left.location.reference));
  1209. end
  1210. end
  1211. else
  1212. begin
  1213. { BUG HERE : detected with nasm :
  1214. hregister is allways 32 bit
  1215. it should be converted to 16 or 8 bit depending on op_size PM }
  1216. { still not perfect :
  1217. if hregister is already a 16 bit reg ?? PM }
  1218. { makeregXX is the solution (FK) }
  1219. case opsize of
  1220. S_B : hregister:=makereg8(hregister);
  1221. S_W : hregister:=makereg16(hregister);
  1222. end;
  1223. if tcallparanode(left).left.location.loc=LOC_CREGISTER then
  1224. emit_reg_reg(addsubop[inlinenumber],opsize,
  1225. hregister,tcallparanode(left).left.location.register)
  1226. else
  1227. emit_reg_ref(addsubop[inlinenumber],opsize,
  1228. hregister,newreference(tcallparanode(left).left.location.reference));
  1229. case opsize of
  1230. S_B : hregister:=reg8toreg32(hregister);
  1231. S_W : hregister:=reg16toreg32(hregister);
  1232. end;
  1233. ungetregister32(hregister);
  1234. end;
  1235. emitoverflowcheck(tcallparanode(left).left);
  1236. emitrangecheck(tcallparanode(left).left,tcallparanode(left).left.resulttype.def);
  1237. end;
  1238. in_typeinfo_x:
  1239. begin
  1240. tstoreddef(ttypenode(tcallparanode(left).left).resulttype.def).generate_rtti;
  1241. location.register:=getregister32;
  1242. new(r);
  1243. reset_reference(r^);
  1244. r^.symbol:=tstoreddef(ttypenode(tcallparanode(left).left).resulttype.def).rtti_label;
  1245. emit_ref_reg(A_LEA,S_L,r,location.register);
  1246. end;
  1247. in_finalize_x:
  1248. begin
  1249. pushusedregisters(pushed,$ff);
  1250. { force rtti generation }
  1251. tstoreddef(ttypenode(tcallparanode(left).left).resulttype.def).generate_rtti;
  1252. { if a count is passed, push size, typeinfo and count }
  1253. if assigned(tcallparanode(left).right) then
  1254. begin
  1255. secondpass(tcallparanode(tcallparanode(left).right).left);
  1256. push_int(tcallparanode(left).left.resulttype.def.size);
  1257. if codegenerror then
  1258. exit;
  1259. emit_push_loc(tcallparanode(tcallparanode(left).right).left.location);
  1260. end;
  1261. { generate a reference }
  1262. reset_reference(hr);
  1263. hr.symbol:=tstoreddef(ttypenode(tcallparanode(left).left).resulttype.def).rtti_label;
  1264. emitpushreferenceaddr(hr);
  1265. { data to finalize }
  1266. secondpass(tcallparanode(left).left);
  1267. if codegenerror then
  1268. exit;
  1269. emitpushreferenceaddr(tcallparanode(left).left.location.reference);
  1270. saveregvars($ff);
  1271. if assigned(tcallparanode(left).right) then
  1272. emitcall('FPC_FINALIZEARRAY')
  1273. else
  1274. emitcall('FPC_FINALIZE');
  1275. popusedregisters(pushed);
  1276. end;
  1277. in_assigned_x :
  1278. begin
  1279. secondpass(tcallparanode(left).left);
  1280. location.loc:=LOC_FLAGS;
  1281. if (tcallparanode(left).left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  1282. begin
  1283. emit_reg_reg(A_OR,S_L,
  1284. tcallparanode(left).left.location.register,
  1285. tcallparanode(left).left.location.register);
  1286. ungetregister32(tcallparanode(left).left.location.register);
  1287. end
  1288. else
  1289. begin
  1290. emit_const_ref(A_CMP,S_L,0,
  1291. newreference(tcallparanode(left).left.location.reference));
  1292. del_reference(tcallparanode(left).left.location.reference);
  1293. end;
  1294. location.resflags:=F_NE;
  1295. end;
  1296. in_reset_typedfile,in_rewrite_typedfile :
  1297. begin
  1298. pushusedregisters(pushed,$ff);
  1299. emit_const(A_PUSH,S_L,tfiledef(left.resulttype.def).typedfiletype.def.size);
  1300. secondpass(left);
  1301. emitpushreferenceaddr(left.location.reference);
  1302. saveregvars($ff);
  1303. if inlinenumber=in_reset_typedfile then
  1304. emitcall('FPC_RESET_TYPED')
  1305. else
  1306. emitcall('FPC_REWRITE_TYPED');
  1307. popusedregisters(pushed);
  1308. end;
  1309. in_setlength_x:
  1310. begin
  1311. pushusedregisters(pushed,$ff);
  1312. l:=0;
  1313. { push dimensions }
  1314. hp:=left;
  1315. while assigned(tcallparanode(hp).right) do
  1316. begin
  1317. inc(l);
  1318. hp:=tcallparanode(hp).right;
  1319. end;
  1320. def:=tcallparanode(hp).left.resulttype.def;
  1321. hp:=left;
  1322. if is_dynamic_array(def) then
  1323. begin
  1324. { get temp. space }
  1325. gettempofsizereference(l*4,hr);
  1326. { keep data start }
  1327. hr2:=hr;
  1328. { copy dimensions }
  1329. hp:=left;
  1330. while assigned(tcallparanode(hp).right) do
  1331. begin
  1332. secondpass(tcallparanode(hp).left);
  1333. emit_mov_loc_ref(tcallparanode(hp).left.location,hr,
  1334. S_L,true);
  1335. inc(hr.offset,4);
  1336. hp:=tcallparanode(hp).right;
  1337. end;
  1338. end
  1339. else
  1340. begin
  1341. secondpass(tcallparanode(hp).left);
  1342. emit_push_loc(tcallparanode(hp).left.location);
  1343. hp:=tcallparanode(hp).right;
  1344. end;
  1345. { handle shortstrings separately since the hightree must be }
  1346. { pushed too (JM) }
  1347. if not(is_dynamic_array(def)) and
  1348. (tstringdef(def).string_typ = st_shortstring) then
  1349. begin
  1350. dummycoll:=TParaItem.Create;
  1351. dummycoll.paratyp:=vs_var;
  1352. dummycoll.paratype:=openshortstringtype;
  1353. tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
  1354. dummycoll.free;
  1355. if codegenerror then
  1356. exit;
  1357. end
  1358. else secondpass(tcallparanode(hp).left);
  1359. if is_dynamic_array(def) then
  1360. begin
  1361. emitpushreferenceaddr(hr2);
  1362. push_int(l);
  1363. reset_reference(hr2);
  1364. hr2.symbol:=tstoreddef(def).get_inittable_label;
  1365. emitpushreferenceaddr(hr2);
  1366. emitpushreferenceaddr(tcallparanode(hp).left.location.reference);
  1367. saveregvars($ff);
  1368. emitcall('FPC_DYNARR_SETLENGTH');
  1369. ungetiftemp(hr);
  1370. end
  1371. else
  1372. { must be string }
  1373. begin
  1374. case tstringdef(def).string_typ of
  1375. st_widestring:
  1376. begin
  1377. emitpushreferenceaddr(tcallparanode(hp).left.location.reference);
  1378. saveregvars($ff);
  1379. emitcall('FPC_WIDESTR_SETLENGTH');
  1380. end;
  1381. st_ansistring:
  1382. begin
  1383. emitpushreferenceaddr(tcallparanode(hp).left.location.reference);
  1384. saveregvars($ff);
  1385. emitcall('FPC_ANSISTR_SETLENGTH');
  1386. end;
  1387. st_shortstring:
  1388. begin
  1389. saveregvars($ff);
  1390. emitcall('FPC_SHORTSTR_SETLENGTH');
  1391. end;
  1392. end;
  1393. end;
  1394. popusedregisters(pushed);
  1395. end;
  1396. in_write_x :
  1397. handlereadwrite(false,false);
  1398. in_writeln_x :
  1399. handlereadwrite(false,true);
  1400. in_read_x :
  1401. handlereadwrite(true,false);
  1402. in_readln_x :
  1403. handlereadwrite(true,true);
  1404. in_str_x_string :
  1405. begin
  1406. handle_str;
  1407. maybe_loadself;
  1408. end;
  1409. in_val_x :
  1410. Begin
  1411. handle_val;
  1412. End;
  1413. in_include_x_y,
  1414. in_exclude_x_y:
  1415. begin
  1416. secondpass(tcallparanode(left).left);
  1417. if tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn then
  1418. begin
  1419. { calculate bit position }
  1420. l:=1 shl (tordconstnode(tcallparanode(tcallparanode(left).right).left).value mod 32);
  1421. { determine operator }
  1422. if inlinenumber=in_include_x_y then
  1423. asmop:=A_OR
  1424. else
  1425. begin
  1426. asmop:=A_AND;
  1427. l:=not(l);
  1428. end;
  1429. if (tcallparanode(left).left.location.loc=LOC_REFERENCE) then
  1430. begin
  1431. inc(tcallparanode(left).left.location.reference.offset,
  1432. (tordconstnode(tcallparanode(tcallparanode(left).right).left).value div 32)*4);
  1433. emit_const_ref(asmop,S_L,
  1434. l,newreference(tcallparanode(left).left.location.reference));
  1435. del_reference(tcallparanode(left).left.location.reference);
  1436. end
  1437. else
  1438. { LOC_CREGISTER }
  1439. begin
  1440. secondpass(tcallparanode(left).left);
  1441. emit_const_reg(asmop,S_L,
  1442. l,tcallparanode(left).left.location.register);
  1443. end;
  1444. end
  1445. else
  1446. begin
  1447. { generate code for the element to set }
  1448. ispushed:=maybe_push(tcallparanode(tcallparanode(left).right).left.registers32,
  1449. tcallparanode(left).left,false);
  1450. secondpass(tcallparanode(tcallparanode(left).right).left);
  1451. if ispushed then
  1452. restore(tcallparanode(left).left,false);
  1453. { determine asm operator }
  1454. if inlinenumber=in_include_x_y then
  1455. asmop:=A_BTS
  1456. else
  1457. asmop:=A_BTR;
  1458. if tsetdef(left.resulttype.def).settype=smallset then
  1459. begin
  1460. if tcallparanode(tcallparanode(left).right).left.location.loc in [LOC_CREGISTER,LOC_REGISTER] then
  1461. { we don't need a mod 32 because this is done automatically }
  1462. { by the bts instruction. For proper checking we would }
  1463. { need a cmp and jmp, but this should be done by the }
  1464. { type cast code which does range checking if necessary (FK) }
  1465. hregister:=makereg32(tcallparanode(tcallparanode(left).right).left.location.register)
  1466. else
  1467. begin
  1468. getexplicitregister32(R_EDI);
  1469. hregister:=R_EDI;
  1470. opsize:=def2def_opsize(
  1471. tcallparanode(tcallparanode(left).right).left.resulttype.def,u32bittype.def);
  1472. if opsize in [S_B,S_W,S_L] then
  1473. op:=A_MOV
  1474. else
  1475. op:=A_MOVZX;
  1476. emit_ref_reg(op,opsize,
  1477. newreference(
  1478. tcallparanode(tcallparanode(left).right).left.location.reference),R_EDI);
  1479. end;
  1480. if (tcallparanode(left).left.location.loc=LOC_REFERENCE) then
  1481. emit_reg_ref(asmop,S_L,hregister,
  1482. newreference(tcallparanode(left).left.location.reference))
  1483. else
  1484. emit_reg_reg(asmop,S_L,hregister,
  1485. tcallparanode(left).left.location.register);
  1486. if hregister = R_EDI then
  1487. ungetregister32(R_EDI);
  1488. end
  1489. else
  1490. begin
  1491. pushsetelement(tcallparanode(tcallparanode(left).right).left);
  1492. { normset is allways a ref }
  1493. emitpushreferenceaddr(tcallparanode(left).left.location.reference);
  1494. if inlinenumber=in_include_x_y then
  1495. emitcall('FPC_SET_SET_BYTE')
  1496. else
  1497. emitcall('FPC_SET_UNSET_BYTE');
  1498. {CGMessage(cg_e_include_not_implemented);}
  1499. end;
  1500. end;
  1501. end;
  1502. in_pi:
  1503. begin
  1504. emit_none(A_FLDPI,S_NO);
  1505. inc(fpuvaroffset);
  1506. end;
  1507. in_sin_extended,
  1508. in_arctan_extended,
  1509. in_abs_extended,
  1510. in_sqr_extended,
  1511. in_sqrt_extended,
  1512. in_ln_extended,
  1513. in_cos_extended:
  1514. begin
  1515. secondpass(left);
  1516. case left.location.loc of
  1517. LOC_FPU:
  1518. ;
  1519. LOC_CFPUREGISTER:
  1520. begin
  1521. emit_reg(A_FLD,S_NO,
  1522. correct_fpuregister(left.location.register,fpuvaroffset));
  1523. inc(fpuvaroffset);
  1524. end;
  1525. LOC_REFERENCE,LOC_MEM:
  1526. begin
  1527. floatload(tfloatdef(left.resulttype.def).typ,left.location.reference);
  1528. del_reference(left.location.reference);
  1529. end
  1530. else
  1531. internalerror(309991);
  1532. end;
  1533. case inlinenumber of
  1534. in_sin_extended,
  1535. in_cos_extended:
  1536. begin
  1537. if inlinenumber=in_sin_extended then
  1538. emit_none(A_FSIN,S_NO)
  1539. else
  1540. emit_none(A_FCOS,S_NO);
  1541. {
  1542. getlabel(l1);
  1543. emit_reg(A_FNSTSW,S_NO,R_AX);
  1544. emit_none(A_SAHF,S_NO);
  1545. emitjmp(C_NP,l1);
  1546. emit_reg(A_FSTP,S_NO,R_ST0);
  1547. emit_none(A_FLDZ,S_NO);
  1548. emitlab(l1);
  1549. }
  1550. end;
  1551. in_arctan_extended:
  1552. begin
  1553. emit_none(A_FLD1,S_NO);
  1554. emit_none(A_FPATAN,S_NO);
  1555. end;
  1556. in_abs_extended:
  1557. emit_none(A_FABS,S_NO);
  1558. in_sqr_extended:
  1559. begin
  1560. (* emit_reg(A_FLD,S_NO,R_ST0);
  1561. { emit_none(A_FMULP,S_NO); nasm does not accept this PM }
  1562. emit_reg_reg(A_FMULP,S_NO,R_ST0,R_ST1);
  1563. can be shorten to *)
  1564. emit_reg_reg(A_FMUL,S_NO,R_ST0,R_ST0);
  1565. end;
  1566. in_sqrt_extended:
  1567. emit_none(A_FSQRT,S_NO);
  1568. in_ln_extended:
  1569. begin
  1570. emit_none(A_FLDLN2,S_NO);
  1571. emit_none(A_FXCH,S_NO);
  1572. emit_none(A_FYL2X,S_NO);
  1573. end;
  1574. end;
  1575. end;
  1576. {$ifdef SUPPORT_MMX}
  1577. in_mmx_pcmpeqb..in_mmx_pcmpgtw:
  1578. begin
  1579. if left.location.loc=LOC_REGISTER then
  1580. begin
  1581. {!!!!!!!}
  1582. end
  1583. else if tcallparanode(left).left.location.loc=LOC_REGISTER then
  1584. begin
  1585. {!!!!!!!}
  1586. end
  1587. else
  1588. begin
  1589. {!!!!!!!}
  1590. end;
  1591. end;
  1592. {$endif SUPPORT_MMX}
  1593. else internalerror(9);
  1594. end;
  1595. { reset pushedparasize }
  1596. pushedparasize:=oldpushedparasize;
  1597. end;
  1598. begin
  1599. cinlinenode:=ti386inlinenode;
  1600. end.
  1601. {
  1602. $Log$
  1603. Revision 1.14 2001-04-13 01:22:19 peter
  1604. * symtable change to classes
  1605. * range check generation and errors fixed, make cycle DEBUG=1 works
  1606. * memory leaks fixed
  1607. Revision 1.13 2001/04/02 21:20:37 peter
  1608. * resulttype rewrite
  1609. Revision 1.12 2001/03/13 11:52:48 jonas
  1610. * fixed some memory leaks
  1611. Revision 1.11 2000/12/25 00:07:33 peter
  1612. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  1613. tlinkedlist objects)
  1614. Revision 1.10 2000/12/09 22:51:37 florian
  1615. * helper name of val for qword fixed
  1616. Revision 1.9 2000/12/07 17:19:46 jonas
  1617. * new constant handling: from now on, hex constants >$7fffffff are
  1618. parsed as unsigned constants (otherwise, $80000000 got sign extended
  1619. and became $ffffffff80000000), all constants in the longint range
  1620. become longints, all constants >$7fffffff and <=cardinal($ffffffff)
  1621. are cardinals and the rest are int64's.
  1622. * added lots of longint typecast to prevent range check errors in the
  1623. compiler and rtl
  1624. * type casts of symbolic ordinal constants are now preserved
  1625. * fixed bug where the original resulttype.def wasn't restored correctly
  1626. after doing a 64bit rangecheck
  1627. Revision 1.8 2000/12/05 11:44:33 jonas
  1628. + new integer regvar handling, should be much more efficient
  1629. Revision 1.7 2000/11/29 00:30:47 florian
  1630. * unused units removed from uses clause
  1631. * some changes for widestrings
  1632. Revision 1.6 2000/11/12 23:24:15 florian
  1633. * interfaces are basically running
  1634. Revision 1.5 2000/11/09 17:46:56 florian
  1635. * System.TypeInfo fixed
  1636. + System.Finalize implemented
  1637. + some new keywords for interface support added
  1638. Revision 1.4 2000/10/31 22:02:56 peter
  1639. * symtable splitted, no real code changes
  1640. Revision 1.3 2000/10/26 14:15:07 jonas
  1641. * fixed setlength for shortstrings
  1642. Revision 1.2 2000/10/21 18:16:13 florian
  1643. * a lot of changes:
  1644. - basic dyn. array support
  1645. - basic C++ support
  1646. - some work for interfaces done
  1647. ....
  1648. Revision 1.1 2000/10/15 09:33:31 peter
  1649. * moved n386*.pas to i386/ cpu_target dir
  1650. Revision 1.2 2000/10/15 09:08:58 peter
  1651. * use System for the systemunit instead of target dependent
  1652. Revision 1.1 2000/10/14 10:14:49 peter
  1653. * moehrendorf oct 2000 rewrite
  1654. }