cg386inl.pas 63 KB

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