n386inl.pas 71 KB

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