n386inl.pas 64 KB

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