cg386inl.pas 62 KB

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