2
0

cg386inl.pas 64 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608
  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. 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. truelabel:=otlabel;
  835. falselabel:=oflabel;
  836. end;
  837. in_lo_word,
  838. in_hi_word :
  839. begin
  840. secondpass(p^.left);
  841. p^.location.loc:=LOC_REGISTER;
  842. if p^.left^.location.loc<>LOC_REGISTER then
  843. begin
  844. if p^.left^.location.loc=LOC_CREGISTER then
  845. begin
  846. p^.location.register:=reg32toreg16(getregister32);
  847. emit_reg_reg(A_MOV,S_W,p^.left^.location.register,
  848. p^.location.register);
  849. end
  850. else
  851. begin
  852. del_reference(p^.left^.location.reference);
  853. p^.location.register:=reg32toreg16(getregister32);
  854. emit_ref_reg(A_MOV,S_W,newreference(p^.left^.location.reference),
  855. p^.location.register);
  856. end;
  857. end
  858. else p^.location.register:=p^.left^.location.register;
  859. if p^.inlinenumber=in_hi_word then
  860. emit_const_reg(A_SHR,S_W,8,p^.location.register);
  861. p^.location.register:=reg16toreg8(p^.location.register);
  862. end;
  863. in_sizeof_x,
  864. in_typeof_x :
  865. begin
  866. { for both cases load vmt }
  867. if p^.left^.treetype=typen then
  868. begin
  869. p^.location.register:=getregister32;
  870. emit_sym_ofs_reg(A_MOV,
  871. S_L,newasmsymbol(pobjectdef(p^.left^.resulttype)^.vmt_mangledname),0,
  872. p^.location.register);
  873. end
  874. else
  875. begin
  876. secondpass(p^.left);
  877. del_reference(p^.left^.location.reference);
  878. p^.location.loc:=LOC_REGISTER;
  879. p^.location.register:=getregister32;
  880. { load VMT pointer }
  881. inc(p^.left^.location.reference.offset,
  882. pobjectdef(p^.left^.resulttype)^.vmt_offset);
  883. emit_ref_reg(A_MOV,S_L,
  884. newreference(p^.left^.location.reference),
  885. p^.location.register);
  886. end;
  887. { in sizeof load size }
  888. if p^.inlinenumber=in_sizeof_x then
  889. begin
  890. new(r);
  891. reset_reference(r^);
  892. r^.base:=p^.location.register;
  893. emit_ref_reg(A_MOV,S_L,r,
  894. p^.location.register);
  895. end;
  896. end;
  897. in_lo_long,
  898. in_hi_long :
  899. begin
  900. secondpass(p^.left);
  901. p^.location.loc:=LOC_REGISTER;
  902. if p^.left^.location.loc<>LOC_REGISTER then
  903. begin
  904. if p^.left^.location.loc=LOC_CREGISTER then
  905. begin
  906. p^.location.register:=getregister32;
  907. emit_reg_reg(A_MOV,S_L,p^.left^.location.register,
  908. p^.location.register);
  909. end
  910. else
  911. begin
  912. del_reference(p^.left^.location.reference);
  913. p^.location.register:=getregister32;
  914. emit_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
  915. p^.location.register);
  916. end;
  917. end
  918. else p^.location.register:=p^.left^.location.register;
  919. if p^.inlinenumber=in_hi_long then
  920. emit_const_reg(A_SHR,S_L,16,p^.location.register);
  921. p^.location.register:=reg32toreg16(p^.location.register);
  922. end;
  923. in_lo_qword,
  924. in_hi_qword:
  925. begin
  926. secondpass(p^.left);
  927. p^.location.loc:=LOC_REGISTER;
  928. case p^.left^.location.loc of
  929. LOC_CREGISTER:
  930. begin
  931. p^.location.register:=getregister32;
  932. if p^.inlinenumber=in_hi_qword then
  933. emit_reg_reg(A_MOV,S_L,p^.left^.location.registerhigh,
  934. p^.location.register)
  935. else
  936. emit_reg_reg(A_MOV,S_L,p^.left^.location.registerlow,
  937. p^.location.register)
  938. end;
  939. LOC_MEM,LOC_REFERENCE:
  940. begin
  941. del_reference(p^.left^.location.reference);
  942. p^.location.register:=getregister32;
  943. r:=newreference(p^.left^.location.reference);
  944. if p^.inlinenumber=in_hi_qword then
  945. inc(r^.offset,4);
  946. emit_ref_reg(A_MOV,S_L,
  947. r,p^.location.register);
  948. end;
  949. LOC_REGISTER:
  950. begin
  951. if p^.inlinenumber=in_hi_qword then
  952. begin
  953. p^.location.register:=p^.left^.location.registerhigh;
  954. ungetregister32(p^.left^.location.registerlow);
  955. end
  956. else
  957. begin
  958. p^.location.register:=p^.left^.location.registerlow;
  959. ungetregister32(p^.left^.location.registerhigh);
  960. end;
  961. end;
  962. end;
  963. end;
  964. in_length_string :
  965. begin
  966. secondpass(p^.left);
  967. set_location(p^.location,p^.left^.location);
  968. { length in ansi strings is at offset -8 }
  969. if is_ansistring(p^.left^.resulttype) then
  970. dec(p^.location.reference.offset,8)
  971. { char is always 1, so make it a constant value }
  972. else if is_char(p^.left^.resulttype) then
  973. begin
  974. clear_location(p^.location);
  975. p^.location.loc:=LOC_MEM;
  976. p^.location.reference.is_immediate:=true;
  977. p^.location.reference.offset:=1;
  978. end;
  979. end;
  980. in_pred_x,
  981. in_succ_x:
  982. begin
  983. secondpass(p^.left);
  984. if not (cs_check_overflow in aktlocalswitches) then
  985. if p^.inlinenumber=in_pred_x then
  986. asmop:=A_DEC
  987. else
  988. asmop:=A_INC
  989. else
  990. if p^.inlinenumber=in_pred_x then
  991. asmop:=A_SUB
  992. else
  993. asmop:=A_ADD;
  994. case p^.resulttype^.size of
  995. 8 : opsize:=S_L;
  996. 4 : opsize:=S_L;
  997. 2 : opsize:=S_W;
  998. 1 : opsize:=S_B;
  999. else
  1000. internalerror(10080);
  1001. end;
  1002. p^.location.loc:=LOC_REGISTER;
  1003. if p^.resulttype^.size=8 then
  1004. begin
  1005. if p^.left^.location.loc<>LOC_REGISTER then
  1006. begin
  1007. if p^.left^.location.loc=LOC_CREGISTER then
  1008. begin
  1009. p^.location.registerlow:=getregister32;
  1010. p^.location.registerhigh:=getregister32;
  1011. emit_reg_reg(A_MOV,opsize,p^.left^.location.registerlow,
  1012. p^.location.registerlow);
  1013. emit_reg_reg(A_MOV,opsize,p^.left^.location.registerhigh,
  1014. p^.location.registerhigh);
  1015. end
  1016. else
  1017. begin
  1018. del_reference(p^.left^.location.reference);
  1019. p^.location.registerlow:=getregister32;
  1020. p^.location.registerhigh:=getregister32;
  1021. emit_ref_reg(A_MOV,opsize,newreference(p^.left^.location.reference),
  1022. p^.location.registerlow);
  1023. r:=newreference(p^.left^.location.reference);
  1024. inc(r^.offset,4);
  1025. emit_ref_reg(A_MOV,opsize,r,
  1026. p^.location.registerhigh);
  1027. end;
  1028. end
  1029. else
  1030. begin
  1031. p^.location.registerhigh:=p^.left^.location.registerhigh;
  1032. p^.location.registerlow:=p^.left^.location.registerlow;
  1033. end;
  1034. if p^.inlinenumber=in_succ_x then
  1035. begin
  1036. emit_const_reg(A_ADD,opsize,1,
  1037. p^.location.registerlow);
  1038. emit_const_reg(A_ADC,opsize,0,
  1039. p^.location.registerhigh);
  1040. end
  1041. else
  1042. begin
  1043. emit_const_reg(A_SUB,opsize,1,
  1044. p^.location.registerlow);
  1045. emit_const_reg(A_SBB,opsize,0,
  1046. p^.location.registerhigh);
  1047. end;
  1048. end
  1049. else
  1050. begin
  1051. if p^.left^.location.loc<>LOC_REGISTER then
  1052. begin
  1053. { first, we've to release the source location ... }
  1054. if p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE] then
  1055. del_reference(p^.left^.location.reference);
  1056. p^.location.register:=getregister32;
  1057. if (p^.resulttype^.size=2) then
  1058. p^.location.register:=reg32toreg16(p^.location.register);
  1059. if (p^.resulttype^.size=1) then
  1060. p^.location.register:=reg32toreg8(p^.location.register);
  1061. if p^.left^.location.loc=LOC_CREGISTER then
  1062. emit_reg_reg(A_MOV,opsize,p^.left^.location.register,
  1063. p^.location.register)
  1064. else
  1065. if p^.left^.location.loc=LOC_FLAGS then
  1066. emit_flag2reg(p^.left^.location.resflags,p^.location.register)
  1067. else
  1068. emit_ref_reg(A_MOV,opsize,newreference(p^.left^.location.reference),
  1069. p^.location.register);
  1070. end
  1071. else p^.location.register:=p^.left^.location.register;
  1072. if not (cs_check_overflow in aktlocalswitches) then
  1073. emit_reg(asmop,opsize,
  1074. p^.location.register)
  1075. else
  1076. emit_const_reg(asmop,opsize,1,
  1077. p^.location.register);
  1078. end;
  1079. emitoverflowcheck(p);
  1080. emitrangecheck(p,p^.resulttype);
  1081. end;
  1082. in_dec_x,
  1083. in_inc_x :
  1084. begin
  1085. { set defaults }
  1086. addvalue:=1;
  1087. addconstant:=true;
  1088. { load first parameter, must be a reference }
  1089. secondpass(p^.left^.left);
  1090. case p^.left^.left^.resulttype^.deftype of
  1091. orddef,
  1092. enumdef : begin
  1093. case p^.left^.left^.resulttype^.size of
  1094. 1 : opsize:=S_B;
  1095. 2 : opsize:=S_W;
  1096. 4 : opsize:=S_L;
  1097. 8 : opsize:=S_L;
  1098. end;
  1099. end;
  1100. pointerdef : begin
  1101. opsize:=S_L;
  1102. if porddef(ppointerdef(p^.left^.left^.resulttype)^.pointertype.def)=voiddef then
  1103. addvalue:=1
  1104. else
  1105. addvalue:=ppointerdef(p^.left^.left^.resulttype)^.pointertype.def^.size;
  1106. end;
  1107. else
  1108. internalerror(10081);
  1109. end;
  1110. { second argument specified?, must be a s32bit in register }
  1111. if assigned(p^.left^.right) then
  1112. begin
  1113. ispushed:=maybe_push(p^.left^.right^.left^.registers32,p^.left^.left,false);
  1114. secondpass(p^.left^.right^.left);
  1115. if ispushed then
  1116. restore(p^.left^.left,false);
  1117. { when constant, just multiply the addvalue }
  1118. if is_constintnode(p^.left^.right^.left) then
  1119. addvalue:=addvalue*get_ordinal_value(p^.left^.right^.left)
  1120. else
  1121. begin
  1122. case p^.left^.right^.left^.location.loc of
  1123. LOC_REGISTER,
  1124. LOC_CREGISTER : hregister:=p^.left^.right^.left^.location.register;
  1125. LOC_MEM,
  1126. LOC_REFERENCE : begin
  1127. del_reference(p^.left^.right^.left^.location.reference);
  1128. hregister:=getregister32;
  1129. emit_ref_reg(A_MOV,S_L,
  1130. newreference(p^.left^.right^.left^.location.reference),hregister);
  1131. end;
  1132. else
  1133. internalerror(10082);
  1134. end;
  1135. { insert multiply with addvalue if its >1 }
  1136. if addvalue>1 then
  1137. emit_const_reg(A_IMUL,opsize,
  1138. addvalue,hregister);
  1139. addconstant:=false;
  1140. end;
  1141. end;
  1142. { write the add instruction }
  1143. if addconstant then
  1144. begin
  1145. if (addvalue=1) and not(cs_check_overflow in aktlocalswitches) then
  1146. begin
  1147. if p^.left^.left^.location.loc=LOC_CREGISTER then
  1148. emit_reg(incdecop[p^.inlinenumber],opsize,
  1149. p^.left^.left^.location.register)
  1150. else
  1151. emit_ref(incdecop[p^.inlinenumber],opsize,
  1152. newreference(p^.left^.left^.location.reference))
  1153. end
  1154. else
  1155. begin
  1156. if p^.left^.left^.location.loc=LOC_CREGISTER then
  1157. emit_const_reg(addsubop[p^.inlinenumber],opsize,
  1158. addvalue,p^.left^.left^.location.register)
  1159. else
  1160. emit_const_ref(addsubop[p^.inlinenumber],opsize,
  1161. addvalue,newreference(p^.left^.left^.location.reference));
  1162. end
  1163. end
  1164. else
  1165. begin
  1166. { BUG HERE : detected with nasm :
  1167. hregister is allways 32 bit
  1168. it should be converted to 16 or 8 bit depending on op_size PM }
  1169. { still not perfect :
  1170. if hregister is already a 16 bit reg ?? PM }
  1171. { makeregXX is the solution (FK) }
  1172. case opsize of
  1173. S_B : hregister:=makereg8(hregister);
  1174. S_W : hregister:=makereg16(hregister);
  1175. end;
  1176. if p^.left^.left^.location.loc=LOC_CREGISTER then
  1177. emit_reg_reg(addsubop[p^.inlinenumber],opsize,
  1178. hregister,p^.left^.left^.location.register)
  1179. else
  1180. emit_reg_ref(addsubop[p^.inlinenumber],opsize,
  1181. hregister,newreference(p^.left^.left^.location.reference));
  1182. case opsize of
  1183. S_B : hregister:=reg8toreg32(hregister);
  1184. S_W : hregister:=reg16toreg32(hregister);
  1185. end;
  1186. ungetregister32(hregister);
  1187. end;
  1188. emitoverflowcheck(p^.left^.left);
  1189. emitrangecheck(p^.left^.left,p^.left^.left^.resulttype);
  1190. end;
  1191. in_assigned_x :
  1192. begin
  1193. secondpass(p^.left^.left);
  1194. p^.location.loc:=LOC_FLAGS;
  1195. if (p^.left^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  1196. begin
  1197. emit_reg_reg(A_OR,S_L,
  1198. p^.left^.left^.location.register,
  1199. p^.left^.left^.location.register);
  1200. ungetregister32(p^.left^.left^.location.register);
  1201. end
  1202. else
  1203. begin
  1204. emit_const_ref(A_CMP,S_L,0,
  1205. newreference(p^.left^.left^.location.reference));
  1206. del_reference(p^.left^.left^.location.reference);
  1207. end;
  1208. p^.location.resflags:=F_NE;
  1209. end;
  1210. in_reset_typedfile,in_rewrite_typedfile :
  1211. begin
  1212. pushusedregisters(pushed,$ff);
  1213. emit_const(A_PUSH,S_L,pfiledef(p^.left^.resulttype)^.typedfiletype.def^.size);
  1214. secondpass(p^.left);
  1215. emitpushreferenceaddr(p^.left^.location.reference);
  1216. if p^.inlinenumber=in_reset_typedfile then
  1217. emitcall('FPC_RESET_TYPED')
  1218. else
  1219. emitcall('FPC_REWRITE_TYPED');
  1220. popusedregisters(pushed);
  1221. end;
  1222. in_write_x :
  1223. handlereadwrite(false,false);
  1224. in_writeln_x :
  1225. handlereadwrite(false,true);
  1226. in_read_x :
  1227. handlereadwrite(true,false);
  1228. in_readln_x :
  1229. handlereadwrite(true,true);
  1230. in_str_x_string :
  1231. begin
  1232. handle_str;
  1233. maybe_loadesi;
  1234. end;
  1235. in_val_x :
  1236. Begin
  1237. handle_val;
  1238. End;
  1239. in_include_x_y,
  1240. in_exclude_x_y:
  1241. begin
  1242. secondpass(p^.left^.left);
  1243. if p^.left^.right^.left^.treetype=ordconstn then
  1244. begin
  1245. { calculate bit position }
  1246. l:=1 shl (p^.left^.right^.left^.value mod 32);
  1247. { determine operator }
  1248. if p^.inlinenumber=in_include_x_y then
  1249. asmop:=A_OR
  1250. else
  1251. begin
  1252. asmop:=A_AND;
  1253. l:=not(l);
  1254. end;
  1255. if (p^.left^.left^.location.loc=LOC_REFERENCE) then
  1256. begin
  1257. inc(p^.left^.left^.location.reference.offset,(p^.left^.right^.left^.value div 32)*4);
  1258. emit_const_ref(asmop,S_L,
  1259. l,newreference(p^.left^.left^.location.reference));
  1260. del_reference(p^.left^.left^.location.reference);
  1261. end
  1262. else
  1263. { LOC_CREGISTER }
  1264. emit_const_reg(asmop,S_L,
  1265. l,p^.left^.left^.location.register);
  1266. end
  1267. else
  1268. begin
  1269. { generate code for the element to set }
  1270. ispushed:=maybe_push(p^.left^.right^.left^.registers32,p^.left^.left,false);
  1271. secondpass(p^.left^.right^.left);
  1272. if ispushed then
  1273. restore(p^.left^.left,false);
  1274. { determine asm operator }
  1275. if p^.inlinenumber=in_include_x_y then
  1276. asmop:=A_BTS
  1277. else
  1278. asmop:=A_BTR;
  1279. if psetdef(p^.left^.resulttype)^.settype=smallset then
  1280. begin
  1281. if p^.left^.right^.left^.location.loc in [LOC_CREGISTER,LOC_REGISTER] then
  1282. hregister:=p^.left^.right^.left^.location.register
  1283. else
  1284. begin
  1285. hregister:=R_EDI;
  1286. opsize:=def2def_opsize(p^.left^.right^.left^.resulttype,u32bitdef);
  1287. if opsize in [S_B,S_W,S_L] then
  1288. op:=A_MOV
  1289. else
  1290. op:=A_MOVZX;
  1291. emit_ref_reg(op,opsize,
  1292. newreference(p^.left^.right^.left^.location.reference),R_EDI);
  1293. end;
  1294. if (p^.left^.left^.location.loc=LOC_REFERENCE) then
  1295. emit_reg_ref(asmop,S_L,hregister,
  1296. newreference(p^.left^.left^.location.reference))
  1297. else
  1298. emit_reg_reg(asmop,S_L,hregister,
  1299. p^.left^.left^.location.register);
  1300. end
  1301. else
  1302. begin
  1303. pushsetelement(p^.left^.right^.left);
  1304. { normset is allways a ref }
  1305. emitpushreferenceaddr(p^.left^.left^.location.reference);
  1306. if p^.inlinenumber=in_include_x_y then
  1307. emitcall('FPC_SET_SET_BYTE')
  1308. else
  1309. emitcall('FPC_SET_UNSET_BYTE');
  1310. {CGMessage(cg_e_include_not_implemented);}
  1311. end;
  1312. end;
  1313. end;
  1314. in_pi:
  1315. begin
  1316. emit_none(A_FLDPI,S_NO);
  1317. inc(fpuvaroffset);
  1318. end;
  1319. in_sin_extended,
  1320. in_arctan_extended,
  1321. in_abs_extended,
  1322. in_sqr_extended,
  1323. in_sqrt_extended,
  1324. in_ln_extended,
  1325. in_cos_extended:
  1326. begin
  1327. secondpass(p^.left);
  1328. case p^.left^.location.loc of
  1329. LOC_FPU:
  1330. ;
  1331. LOC_CFPUREGISTER:
  1332. begin
  1333. emit_reg(A_FLD,S_NO,
  1334. correct_fpuregister(p^.left^.location.register,fpuvaroffset));
  1335. inc(fpuvaroffset);
  1336. end;
  1337. LOC_REFERENCE,LOC_MEM:
  1338. floatload(pfloatdef(p^.left^.resulttype)^.typ,p^.left^.location.reference);
  1339. else
  1340. internalerror(309991);
  1341. end;
  1342. case p^.inlinenumber of
  1343. in_sin_extended,
  1344. in_cos_extended:
  1345. begin
  1346. getlabel(l1);
  1347. if p^.inlinenumber=in_sin_extended then
  1348. emit_none(A_FSIN,S_NO)
  1349. else
  1350. emit_none(A_FCOS,S_NO);
  1351. {
  1352. emit_reg(A_FNSTSW,S_NO,R_AX);
  1353. emit_none(A_SAHF,S_NO);
  1354. emitjmp(C_NP,l1);
  1355. emit_reg(A_FSTP,S_NO,R_ST0);
  1356. emit_none(A_FLDZ,S_NO);
  1357. emitlab(l1);
  1358. }
  1359. end;
  1360. in_arctan_extended:
  1361. begin
  1362. emit_none(A_FLD1,S_NO);
  1363. emit_none(A_FPATAN,S_NO);
  1364. end;
  1365. in_abs_extended:
  1366. emit_none(A_FABS,S_NO);
  1367. in_sqr_extended:
  1368. begin
  1369. emit_reg(A_FLD,S_NO,R_ST0);
  1370. emit_none(A_FMULP,S_NO);
  1371. end;
  1372. in_sqrt_extended:
  1373. emit_none(A_FSQRT,S_NO);
  1374. in_ln_extended:
  1375. begin
  1376. emit_none(A_FLDLN2,S_NO);
  1377. emit_none(A_FXCH,S_NO);
  1378. emit_none(A_FYL2X,S_NO);
  1379. end;
  1380. end;
  1381. end;
  1382. {$ifdef SUPPORT_MMX}
  1383. in_mmx_pcmpeqb..in_mmx_pcmpgtw:
  1384. begin
  1385. if p^.left^.location.loc=LOC_REGISTER then
  1386. begin
  1387. {!!!!!!!}
  1388. end
  1389. else if p^.left^.left^.location.loc=LOC_REGISTER then
  1390. begin
  1391. {!!!!!!!}
  1392. end
  1393. else
  1394. begin
  1395. {!!!!!!!}
  1396. end;
  1397. end;
  1398. {$endif SUPPORT_MMX}
  1399. else internalerror(9);
  1400. end;
  1401. { reset pushedparasize }
  1402. pushedparasize:=oldpushedparasize;
  1403. end;
  1404. end.
  1405. {
  1406. $Log$
  1407. Revision 1.87 2000-01-07 01:14:20 peter
  1408. * updated copyright to 2000
  1409. Revision 1.86 1999/12/22 01:01:46 peter
  1410. - removed freelabel()
  1411. * added undefined label detection in internal assembler, this prevents
  1412. a lot of ld crashes and wrong .o files
  1413. * .o files aren't written anymore if errors have occured
  1414. * inlining of assembler labels is now correct
  1415. Revision 1.85 1999/12/20 21:42:35 pierre
  1416. + dllversion global variable
  1417. * FPC_USE_CPREFIX code removed, not necessary anymore
  1418. as we use .edata direct writing by default now.
  1419. Revision 1.84 1999/12/14 10:17:40 florian
  1420. * fixed an internalerror 10 with pred(...)
  1421. Revision 1.83 1999/12/02 12:38:45 florian
  1422. + added support for succ/pred(<qword/int64>)
  1423. Revision 1.82 1999/12/01 12:42:31 peter
  1424. * fixed bug 698
  1425. * removed some notes about unused vars
  1426. Revision 1.81 1999/11/30 10:40:42 peter
  1427. + ttype, tsymlist
  1428. Revision 1.80 1999/11/29 00:30:06 pierre
  1429. * fix for form bug 699
  1430. Revision 1.79 1999/11/20 01:22:18 pierre
  1431. + cond FPC_USE_CPREFIX (needs also some RTL changes)
  1432. this allows to use unit global vars as DLL exports
  1433. (the underline prefix seems needed by dlltool)
  1434. Revision 1.78 1999/11/09 22:54:45 peter
  1435. * fixed wrong asm with inc(qword), but not it's not correctly supported
  1436. Revision 1.77 1999/11/06 14:34:17 peter
  1437. * truncated log to 20 revs
  1438. Revision 1.76 1999/10/29 15:28:51 peter
  1439. * fixed assert, the tree is now disposed in firstpass if assertions
  1440. are off.
  1441. Revision 1.75 1999/10/26 12:30:40 peter
  1442. * const parameter is now checked
  1443. * better and generic check if a node can be used for assigning
  1444. * export fixes
  1445. * procvar equal works now (it never had worked at least from 0.99.8)
  1446. * defcoll changed to linkedlist with pparaitem so it can easily be
  1447. walked both directions
  1448. Revision 1.74 1999/10/21 16:41:38 florian
  1449. * problems with readln fixed: esi wasn't restored correctly when
  1450. reading ordinal fields of objects futher the register allocation
  1451. didn't take care of the extra register when reading ordinal values
  1452. * enumerations can now be used in constant indexes of properties
  1453. Revision 1.73 1999/09/28 20:48:23 florian
  1454. * fixed bug 610
  1455. + added $D- for TP in symtable.pas else it can't be compiled anymore
  1456. (too much symbols :()
  1457. Revision 1.72 1999/09/26 13:26:05 florian
  1458. * exception patch of Romio nevertheless the excpetion handling
  1459. needs some corections regarding register saving
  1460. * gettempansistring is again a procedure
  1461. Revision 1.71 1999/09/16 07:52:37 pierre
  1462. * FLDPI must increment fpuvaroffset
  1463. Revision 1.70 1999/09/15 20:35:38 florian
  1464. * small fix to operator overloading when in MMX mode
  1465. + the compiler uses now fldz and fld1 if possible
  1466. + some fixes to floating point registers
  1467. + some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
  1468. * .... ???
  1469. Revision 1.69 1999/08/28 15:34:16 florian
  1470. * bug 519 fixed
  1471. Revision 1.68 1999/08/19 13:08:47 pierre
  1472. * emit_??? used
  1473. Revision 1.67 1999/08/10 13:21:08 pierre
  1474. * fpuvaroffset not increased for f32bit float type
  1475. Revision 1.66 1999/08/10 12:47:53 pierre
  1476. * fpuvaroffset problems solved
  1477. Revision 1.65 1999/08/04 00:22:47 florian
  1478. * renamed i386asm and i386base to cpuasm and cpubase
  1479. Revision 1.64 1999/08/03 22:02:42 peter
  1480. * moved bitmask constants to sets
  1481. * some other type/const renamings
  1482. Revision 1.63 1999/07/23 16:05:18 peter
  1483. * alignment is now saved in the symtable
  1484. * C alignment added for records
  1485. * PPU version increased to solve .12 <-> .13 probs
  1486. Revision 1.62 1999/07/05 20:13:10 peter
  1487. * removed temp defines
  1488. Revision 1.61 1999/07/03 14:14:27 florian
  1489. + start of val(int64/qword)
  1490. * longbool, wordbool constants weren't written, fixed
  1491. Revision 1.60 1999/07/01 15:49:09 florian
  1492. * int64/qword type release
  1493. + lo/hi for int64/qword
  1494. Revision 1.59 1999/06/21 16:33:27 jonas
  1495. * fixed include() with smallsets
  1496. Revision 1.58 1999/06/11 11:44:56 peter
  1497. *** empty log message ***
  1498. Revision 1.57 1999/06/02 10:11:43 florian
  1499. * make cycle fixed i.e. compilation with 0.99.10
  1500. * some fixes for qword
  1501. * start of register calling conventions
  1502. }