n386inl.pas 68 KB

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