cg386inl.pas 64 KB

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