cg386inl.pas 66 KB

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