n386inl.pas 72 KB

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