cg386inl.pas 66 KB

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