n386inl.pas 72 KB

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