cg386inl.pas 64 KB

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