n386inl.pas 73 KB

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