cg386inl.pas 66 KB

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